Тема: Help! помогите решить задачу с массивами (VBA в Excel)

Прошу, помогите решить задачу с массивами.
Дана квадратная матрица:
1. Найти среднее арифметическое положительных элементов, которые находятся сверху главной диагонали
2.Это среднее арифметическое значение добавить к элементам в последнем столбце
3. И найти минимальный элемент этой матрицы в каждом ряду.
Помогите, пожалуйста, кто может!

Re: Help! помогите решить задачу с массивами (VBA в Excel)

вставить первую строку между средними строками.

Re: Help! помогите решить задачу с массивами (VBA в Excel)

Очень свежее решение. Прошло 2 с гаком года :)

Re: Help! помогите решить задачу с массивами (VBA в Excel)

=))))))

Re: Help! помогите решить задачу с массивами (VBA в Excel)

Задан массив А,содержащий 20 элементов.Если минимальный из положительных элементов массива больше произведения всех элементов массива,то распечатать третий элемент массива.Написать программу на алгоритмическом языке Бейсик, решающую поставленную задачу.

Re: Help! помогите решить задачу с массивами (VBA в Excel)

> Анютка
Такие задачи быстро не решаются. Надо подождать два года...

Re: Help! помогите решить задачу с массивами (VBA в Excel)

> Анютка
Только ради развлечения

Option Explicit
Sub main()
Dim ar As Variant
ar = Array(-5, 2, 5, -3, -7.08, 2.32, 6, 1, 0.00001, 2.007, -1, -8.5, 9.32, 8, 4.87, 8, 3, -5, 0, 0.25, 0.1)
TestOnMinValue ar
End Sub
Public Sub TestOnMinValue(ar As Variant)
Dim out As Variant
out = GetPositiveOnly(ar)
Dim mini As Variant
mini = Minimum(out)
Debug.Print "Minimal value is: " & mini
Dim mult As Variant
mult = ProductOfArray(ar)
Debug.Print "Product of an array is: " & mult
If CDec(mini) > CDec(mult) Then
Debug.Print "Product of an array is: " & mult & ". Third item in array is " & ar(2)
Else
Debug.Print "Minimal element is  less than" & vbCr & "product of the given array"
End If
End Sub
Public Function Minimum(ar As Variant) As Variant
    Dim i As Integer, mini As Variant
    mini = Null
    For i = 0 To UBound(ar)
        If IsNull(mini) Then
            mini = ar(i)
        ElseIf Not IsNull(ar(i)) Then
            If mini > ar(i) Then
                mini = ar(i)
            End If
        End If
    Next i
    Minimum = mini
End Function
Public Function ProductOfArray(ar As Variant) As Variant
Dim res As Variant
Dim i As Long
res = 1
For i = LBound(ar) To UBound(ar)
res = res * ar(i)
Next
ProductOfArray = res
End Function
Public Function GetPositiveOnly(ar As Variant) As Variant
Dim res() As Variant
Dim i As Long, j As Long
For i = LBound(ar) To UBound(ar)
If ar(i) > 0 Then
ReDim Preserve res(j)
res(j) = ar(i)
j = j + 1
End If
Next
GetPositiveOnly = res
End Function

~'J'~

Re: Help! помогите решить задачу с массивами (VBA в Excel)

Помоги решить задачю в VBA
Книжный магазин продал за 3 месяца различное количество книг(10 наименований) по цене устанавливаемой в начале каждого месяца(т.е каждый месяц цены на книги менялись)
Написать программу на языке VBA, которая вводит данные,выполняет расчеты и выводит на экран:
исходные данные в виде таблице, где указаны наименования книг, цена книг в каждом месяце количество проданных книг за каждый месяц;
доход по каждой книге за 3 месяца;
доход за каждый месяц по всем книгам;
общий доход по всем книгам за 3 месяца;
наименование книги,принесшей наибольший доход.
P.S. С меня На выбор пиво, сок и шоколад

Re: Help! помогите решить задачу с массивами (VBA в Excel)

ПОМОГИТЕ....ПОМОГИТЕ решить задачу...
Матрица А[N,M](M кратно 4) разделена по вертикали на две половины. Определить max элемент каждого столбца левой половины и сумму элементов каждого четного столбца правой матрицы А.

Re: Help! помогите решить задачу с массивами (VBA в Excel)

> Александр
Коряво, но нет времени лакировать

Option Explicit
Option Base 0
'
Sub Array_Test()
'
Dim n As Integer, m As Integer, k As Integer
Dim ar(999, 11) As Variant ' change to your suit
'
On Error GoTo Err_Control
'
For n = 0 To 999 ' change to your suit
For m = 0 To 11 ' change to your suit
ar(n, m) = Round(Rnd(6 * (1 + m)), 3)
Next
Next
'
ReDim mx(0 To UBound(ar, 2) \ 2)
'
For n = 0 To UBound(ar, 2) \ 2
mx(n) = ar(0, n)
Next
'
For n = 1 To UBound(ar, 1)
For m = 0 To UBound(ar, 2) \ 2
If mx(m) < ar(n, m) Then
mx(m) = ar(n, m)
End If
Next
Next
'
Dim sx() As Integer
'
k = 0
For n = (UBound(ar, 2) + 1) \ 2 To UBound(ar, 2)
If n Mod 2 = 0 Then
ReDim Preserve sx(k)
sx(k) = n + 1
k = k + 1
End If
Next
'
ReDim sum(0 To UBound(sx))
For n = 0 To UBound(sx)
For m = 0 To UBound(ar, 1)
sum(n) = sum(n) + ar(m, sx(n))
Next
Next
'
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
'
End Sub

~'J'~