Написать программу в VBA. Заданы массивы А(40,40), В(20,20) и С(30,30).Для каждого из заданных массивов определить количество элементов в строке превышающих среднее арифметическое значение элементов массива
Написать программу в VBA. Заданы массивы А(40,40), В(20,20) и С(30,30).Для каждого из заданных массивов определить количество элементов в строке превышающих среднее арифметическое значение элементов массива
Гость
Ответ(ы) на вопрос:
ГостьOption Explicit
Function Mean2(A As Variant) As Double
'Возвращает среднее арифметическое элементов двухмерного массива
Dim i As Integer, j As Integer, S As Variant, n As Integer
S = 0
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
S = S + A(i, j)
Next j
Next i
n = (UBound(A, 1) - LBound(A, 1) + 1) * (UBound(A, 2) - LBound(A, 1) + 1)
Mean2 = S / n
End Function
Sub InitMas2(A As Variant, amin As Variant, amax As Variant)
'Инициализирует элементы двухмерного массива датчиком случайных чисел
'amin и amax задают диапазон часел для инициализации
Dim i As Integer, j As Integer, typ As Integer, ik As Integer, rk As Single
Dim imin As Integer, jmin As Integer, imax As Integer, jmax As Integer
imin = LBound(A, 1)
imax = UBound(A, 1)
jmin = LBound(A, 2)
jmax = UBound(A, 2)
typ = VarType(A) - 8192
Select Case typ
Case 2, 3, 17
ik = Int(amax - amin + 1)
For i = imin To imax
For j = jmin To jmax
A(i, j) = Int(Rnd * ik + amin)
Next j
Next i
Case Else
rk = amax - amin + 1
For i = imin To imax
For j = jmin To jmax
A(i, j) = Rnd * rk + amin
Next j
Next i
End Select
End Sub
Sub OutMas(A As Variant, prow As Integer, pcol As Integer)
'Размещает элементы одномерного массива на текущем листе рабочей книги
'Ячейка в левом верхнем углу имеет адрес (prow,pcol)
'Размещение идет по колонке
Dim i As Integer, ic As Integer
Dim imin As Integer, imax As Integer
imin = LBound(A, 1)
imax = UBound(A, 1)
ic = prow
For i = imin To imax
Cells(ic, pcol).Value = A(i)
ic = ic + 1
Next i
End Sub
Sub OutMas2(A As Variant, prow As Integer, pcol As Integer)
'Размещает элементы двухмерного массива на текущем листе рабочей книги
'Ячейка в левом верхнем углу имеет адрес (prow,pcol)
Dim i As Integer, j As Integer, ic As Integer, jc As Integer
Dim imin As Integer, jmin As Integer, imax As Integer, jmax As Integer
imin = LBound(A, 1)
imax = UBound(A, 1)
jmin = LBound(A, 2)
jmax = UBound(A, 2)
ic = prow
For i = imin To imax
jc = pcol
For j = jmin To jmax
Cells(ic, jc).Value = A(i, j)
jc = jc + 1
Next j
ic = ic + 1
Next i
End Sub
Sub NumElems2(A As Variant, B() As Integer, pm As Double)
' Находит в каждой строке двухмерного массива а количество элементов,
' превышающих среднее арифметическое всех элементов этого массива pm
' и помещает это количство в одномерный массив b.
Dim i As Integer, j As Integer, kol As Integer
Dim imin As Integer, jmin As Integer, imax As Integer, jmax As Integer
imin = LBound(A, 1)
imax = UBound(A, 1)
jmin = LBound(A, 2)
jmax = UBound(A, 2)
For i = imin To imax
kol = 0
For j = jmin To jmax
If A(i, j) > pm Then kol = kol + 1
Next j
B(i) = kol
Next i
End Sub
Sub main()
Const m = 40, n = 20, p = 30
Dim A(1 To m, 1 To m) As Integer, R(1 To m) As Integer
Dim B(1 To n, 1 To n) As Single, S(1 To n) As Integer
Dim C(1 To p, 1 To p) As Integer, T(1 To p) As Integer
Dim i As Integer, mm As Double
Randomize Timer
InitMas2 A, -1000, 1000
OutMas2 A, 1, 1
mm = Mean2(A)
NumElems2 A, R, mm
OutMas R, 1, m + 2
InitMas2 B, 0, 1800
OutMas2 B, 42, 1
mm = Mean2(B)
NumElems2 B, S, mm
OutMas S, 42, n + 2
InitMas2 C, -1200, 800
OutMas2 C, 63, 1
mm = Mean2(C)
NumElems2 C, T, mm
OutMas T, 63, p + 2
End Sub
Особенность программы: позволяет работать с массивами любых допустимых числовых типов. Размер массивов фактически ограничен только размером свободной оперативной памяти компьютера.
Для запуска не забудьте разрешить исполнение макросы на уровне безопасности не выше "Средний" и дать доверенный доступ к проектам VBA.
Не нашли ответ?
Похожие вопросы