VBA: Сумма и произведение в одномерном массиве

[Bezmenov]

В одномерном массиве, состоящем из n вещественных элементов, вычислить:
• сумму положительных элементов массива;
• произведение элементов массива, расположенных между максимальным по модулю и минимальным по модулю элементами.

Массив я создал:
Sub Массив()
Dim i As Integer, A() As Integer
Worksheets("Лист1").Range("A2:G30").Clear

n = InputBox("введите количество элементов: ")
ReDim A(1 To n)
  For i = 1 To n
  A(i) = Int((10 - (-10) + 1) * Rnd + (-10))
  Worksheets("Лист1").Cells(i + 1, 1) = A(i)
  Next  ' создали массив
     For i = 1 To n
     If A(i) > 0 Then sum = sum + A(i)
     Next ' нашли сумму положительных элементов
         Worksheets("Лист1").Cells(i + 2, 1) = "Сумма положительных элементов = "
         Worksheets("Лист1").Cells(i + 2, 5) = sum

' как сделать второй пункт задания  я не знаю
End Sub

А дальше не получается

[Bezmenov]

Я думаю так, но там ошибка и он не правильно считает

'Определяем минимальный элемент массива по модулю
For i = 1 To n Step 1
      Min = 1
    min_zn = Mod(A(1))
        If Abs(A(i)) < min_zn Then
            Min = i
            min_zn = Abs(A(i))
        End If
    Next i
   
    'Определяем максимальный элемент по модулю.
   
    For i = 1 To n Step 1
     Max = 1
    max_zn = Abs(A(1))
        If Abs(A(i)) > max_zn Then
            Max = i
            max_zn = Abs(A(i))
        End If
    Next i
   
    'Определяем, как перемножить числа между
    'минимальным и максимальным элементом..
    'Если порядковый номер минимального элемента больше
    'порядкововый номер максимального элемента, то
    'будем двигаться от максимального к минимальному.
    If Min > Max Then
        lStart = Max
        lEnd = Min
    Else
        lStart = Min
        lEnd = Max
    End If
   
    'Если между минимальным и максимальным элементом
    'нет, чисел, то выдать сообщение,
    If lEnd - lStart = 1 Or lEnd - lStart = 0 Then
   
        MsgBox " Между минимальным и максимальным элементом нет числа."
   
    'Иначе.
    Else
   
        For i = lStart + 1 To lEnd - 1 Step 1
            p = p * A(i)
        Next i
       
        MsgBox ("Произведение равно: ") & p
    End If
   
   
     

[Администратор]

Макрос. Версия от 17:16

Sub Массив()

    Dim A() As Integer
    Dim dblSum As Double, dblProduct As Double
    Dim intMin_value As Integer, intMin_index As Integer
    Dim intMax_value As Integer, intMax_index As Integer
    Dim intFrom As Integer, intTo As Integer, i As Integer, n As Integer
   
    Worksheets("Лист1").Range("A2:G30").Clear
   
    ' создали массив
    n = InputBox("введите количество элементов:")
    ReDim A(1 To n)
    For i = 1 To n
        A(i) = Int((10 - (-10) + 1) * Rnd + (-10))
        Worksheets("Лист1").Cells(i + 1, 1) = A(i)
    Next
   
    ' нашли сумму положительных элементов
    For i = 1 To n
        If A(i) > 0 Then
            dblSum = dblSum + A(i)
        End If
    Next
   
    Worksheets("Лист1").Cells(i + 2, 1) = "Сумма положительных элементов = "
    Worksheets("Лист1").Cells(i + 2, 5) = dblSum
   
    ' Поиск минимального и максимального (по модулю) элементов.
        ' Сначала за минимальный и максимальный принимается первый элемент,
        ' затем остальные элементы сравниваются с ним и если будет найден
        ' новый минимальный или максимальный, то он будет запомнен и затем
        ' уже другие элементы будут сравниваться с ним.
    ' Двоеточие используется для удобства написания кода - чтобы можно было записать две команды в одну.
    intMin_value = VBA.Abs(A(1)): intMin_index = 1
    intMax_value = VBA.Abs(A(1)): intMax_index = 1
    ' Можно начинать поиск прямо с первого элемента, хотя в этом нет смысла,
        ' т.к. он уже проанализирован, но это проще, если вдруг вам надо будет
        ' работать не с одномерным, а двумерным массивом.
    For i = 1 To UBound(A) Step 1
        If VBA.Abs(A(i)) < intMin_value Then
            intMin_value = VBA.Abs(A(i))
            intMin_index = i
        End If
        If VBA.Abs(A(i)) > intMax_value Then
            intMax_value = VBA.Abs(A(i))
            intMax_index = i
        End If
    Next i
   
    ' Если минимальный и максимальный элемент (по модулю) - это один и тот же элемент,
        ' то расчитывать нечего, т.к. нужно считать между.
    If intMin_index = intMax_index Then
        MsgBox "Между минимальным и максимальным элементом нет чисел.", vbExclamation
        Exit Sub
    End If
   
    ' Произведение элементов массива, расположенных между максимальным по модулю и минимальным по модулю элементами.
    ' Запись в переменную "dblProduct" единицы, иначе всегда будет 0, т.к. в пустой переменной
        ' с типом данных "Double" находится ноль.
    dblProduct = 1
    ' Запись в переменные, с какой по какой элемент нужно двигаться.
    If intMin_index < intMax_index Then
        intFrom = intMin_index
        intTo = intMax_index
    Else
        intFrom = intMax_index
        intTo = intMin_index
    End If
    ' Произведение.
    For i = intFrom + 1 To intTo - 1 Step 1
        dblProduct = dblProduct * A(i)
    Next i
   
    ' Здесь в переменной "dblProduct" содержится результат, который можно вставить в эксель.
   
End Sub

[свернуть]

[Bezmenov]

Спасибо, все работает.