Написать программу в VBA. Заданы массивы А(40,40), В(20,20) и С(30,30).Для каждого из заданных массивов определить количество элементов в строке

+ 0 -

Vasilisyshkalove

21 сент. 2013 г., 16:20:35 (10 лет назад)

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.

+ 0 -

Olechka1732

21 сент. 2013 г., 16:55:47 (10 лет назад)

Комментарий удален

+ 0 -

Брилианта

21 сент. 2013 г., 18:02:12 (10 лет назад)

Комментарий удален

+ 0 -

Pronina092003

21 сент. 2013 г., 19:00:22 (10 лет назад)

Комментарий удален

+ 0 -

Vovano

21 сент. 2013 г., 20:17:51 (10 лет назад)

Комментарий удален

+ 0 -

XD46573

21 сент. 2013 г., 22:40:09 (10 лет назад)

Комментарий удален