Форум по VBA и MS Office

Sub Макрос()
   
    ' Создание в оперативной памяти компьютера массива "arr".
    Dim arr()
    ' Создание в оперативной памяти компьютера переменной "sum".
        ' Double означает, что в переменной могут быть числа (целые и дробные).
    Dim sum As Double


    '1. Заполнение массива согласно формуле.
        ' Если юзер захочет отменить работу макроса, то функция "WriteArr" вернёт "False".
    If WriteArr(arr()) = False Then
        Exit Sub
    End If

    '2. Найти сумму максимального и минимального элементов массива.
    FindSum arr(), sum
   
    '3. Сортировка по убыванию.
    Sort arr()
   
    '4. Вставка результата на активный эксель-лист.
    ' Удаление старых данных.
    ActiveSheet.UsedRange.Clear
    ' Вставка массива.
    Range("A1").Resize(UBound(arr, 1)).Value = arr()
    ' Вставка суммы.
    Range("B1").Value = sum
   
End Sub

Private Function WriteArr(arr()) As Boolean

    ' Заполнение массива согласно формуле.
   
    ' Variant означает, что в переменной может быть текст, числа и другие виды данных.
    Dim var As Variant
    ' Long означает, что в переменной могут быть только числа (целые числа).
    Dim i As Long
   
   
    '1. Юзер записывает число в переменную "var".
    var = InputBox("Введите i:")
    ' Если юзер щёлкнул "Cancel", то в переменной "var" будет пусто.
    If var = "" Then
        Exit Function
    End If
   
    '2. Создание элементов в массиве "arr".
        ' 1 To используется, чтобы порядковый номер первого элемента был 1.
        ' Если не указывать, то порядковый номер будет 0, что неудобно.
        ' 1 To 1 создаёт столбец. Столбец потребуется, чтобы вставить массив
        ' на эксель-лист одним действием.
    ReDim arr(1 To var, 1 To 1)
   
    '3. Заполнение массива по формуле.
        ' For ... To .. Step ... Next - это цикл. Цикл используется,
        ' чтобы делать одну и ту же команду несколько раз.
    For i = 1 To var Step 1
        arr(i, 1) = i * Sin(i) - Cos(i)
    Next i
   
    '4. Пометка, что функция "WriteArr" сделала работу и есть результат.
    WriteArr = True

End Function

Private Sub FindSum(arr(), sum As Double)

    ' Найти сумму максимального и минимального элементов массива.
   
    Dim min As Double, max As Double
    Dim i As Long
   
       
    '1. Поиск минимального и максимального числа.
    ' Сначала за минимальный и максимальный элемент принимаем первый элемент.
        ' Затем остальные элементы будем сравнивать с ним и делать соответствующие выводы.
    min = arr(1, 1)
    max = arr(1, 1)
    ' Ubound - это порядковый номер последнего элемента в массиве.
    For i = 2 To UBound(arr, 1) Step 1
        ' Если текущий элемент меньше переменной "min", то запись в переменную "min" текущего числа.
        ' If ... Then ... End If - используется, чтобы выполнить команду, если это нужно.
        If arr(i, 1) < min Then
            min = arr(i, 1)
        End If
        ' Тот же принцип с максимальным элементом.
        If arr(i, 1) > max Then
            max = arr(i, 1)
        End If
    Next i
   
    '2. Суммирование минимального и максимального.
    sum = min + max
   
End Sub

Private Sub Sort(arr())

    ' Сортировка по убыванию методом "Пузырёк".
   
    Dim i As Long, ii As Long
    Dim stol As Double
   
    For i = 1 To UBound(arr, 1) - 1 Step 1
        For ii = 1 To UBound(arr, 1) - i Step 1
            If arr(ii, 1) < arr(ii + 1, 1) Then
                stol = arr(ii, 1)
                arr(ii, 1) = arr(ii + 1, 1)
                arr(ii + 1, 1) = stol
            End If
        Next ii
    Next i
   
End Sub