Умножение 2 массивов в 3-й диапазон пустых массивов VBA(Excel)

Dim i As Integer, q As Integer
Dim rng As Range
Dim my_array1elm
Dim my_array2elm
Dim x As Long

Sub Yoo()

Range("B1").Select
For i = 1 To 12
    ActiveCell.Value = i
    ActiveCell.Offset(0, 1).Select
Next

Range("A2").Select
For q = 1 To 12
    ActiveCell.Value = q
    ActiveCell.Offset(1, 0).Select
Next

my_array1 = Range("B1:M1").Select
my_array2 = Range("A2:A13").Select
my_array3 = Range("B2:M13").Select

Теперь я хотел бы умножить каждый элемент в my_array1 на каждый элемент в my_array2. Затем заполните результат (матрица) в my_array3

Возникли проблемы с определением циклов.

Источник

5 ответов

Придерживаясь членов Excel, вы можете использовать

Sub Yoo()

    Range("B1").Resize(, 12).Formula = "=COLUMN()-1"
    Range("A2").Resize(12).Formula = "=ROW()-1"
    Range("B2").Resize(12, 12).FormulaR1C1 = "=RC1*R1C"

    With Range("A1").Resize(13, 13)
        .Value = .Value
    End With

End Sub
Источник

Чтение и запись в / из листа неэффективно. Лучше сделать умножение в массивах VBA, а затем записать массивы на лист.

Обратите внимание, что горизонтальный массив является одномерным, вертикальный и многостолбцовый массивы двумерными.

Например:

Option Explicit

Dim i As Integer, q As Integer
Dim rng As Range
Dim my_array1
Dim my_array2
Dim my_array3

Sub Yoo()

ReDim my_array1(1 To 12) 'horizontal array
ReDim my_array2(1 To 12, 1 To 1) 'vertical array
    For i = 1 To 12
        my_array1(i) = i
        my_array2(i, 1) = i
    Next i

ReDim my_array3(1 To 12, 1 To 12) 'results array
For i = 1 To 12
    For q = 1 To 12
        my_array3(i, q) = my_array1(i) * my_array2(q, 1)
    Next q
Next i

Cells.Clear
Range("B1:M1") = my_array1
Range("A2:A13") = my_array2
Range("B2:M13") = my_array3

End Sub

Источник

mmult результат рассчитывается по VBA:

Option Explicit

Sub MatrixMultiplication()
    Dim myArr1 As Variant
    Dim myArr2 As Variant
    Dim result As Variant

    myArr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)
    myArr2 = Application.WorksheetFunction.Transpose(myArr1)
    Range("A2:A21") = myArr2
    Range("B1:U1") = myArr1

    result = Application.MMult(myArr2, myArr1)

    Range("B2:U21") = result

    'Range("B2:U21").FormulaArray = "=MMULT(A2:A21;B1:U1)"
    'Range("B2:U21").FormulaArray = "=MMULT(RC[-1]:R[19]C[-1],R[-1]C:R[-1]C[19])"
End Sub
Источник

Таблица умножения массивов

Измените значения в разделе Const ants, как считаете нужным.

Код

Sub ArrayMultiplicationTable()

    Const cTarget As String = "A1"  ' Target First Cell Range
    Const cCol As Long = 12         ' Size of Column Source Range
    Const cRow As Long = 12         ' Size of Row Source Range

    Dim vntCol As Variant   ' Column Source Array
    Dim vntRow As Variant   ' Row Source Array
    Dim vntT As Variant     ' Target Array
    Dim i As Long           ' Row Array and Target Array Row Counter
    Dim j As Long           ' Column Array and Target Array Column Counter

    ' Redim Source Arrays
    ReDim vntCol(1 To cCol, 1 To 1)
    ReDim vntRow(1 To 1, 1 To cRow)

    ' Populate Column Source Array.
    For i = 1 To cCol
        vntCol(i, 1) = i
    Next
    ' Populate Row Source Array.
    For j = 1 To cRow
        vntRow(1, j) = j
    Next

    ' Redim Target Array.
    ReDim vntT(1 To cCol, 1 To cRow)

    ' Loop through rows of Column Source Array.
    For i = 1 To UBound(vntCol)
        ' Loop through columns of Row Source Array.
        For j = 1 To UBound(vntRow, 2)
            ' Write to Target Array.
            'vntT(i, j) = vntCol(i, 1) * vntRow(1, j)
            ' The following is a simplification of the previous line since
            ' numbers from 1 to Size of Row or Column Source Range are used
            ' as the values in the Source Arrays.
            vntT(i, j) = i * j
        Next
    Next

    ' Copy Arrays to Ranges.
    Range(cTarget).Offset(, 1).Resize(, cRow) = vntRow
    Range(cTarget).Offset(1).Resize(cCol) = vntCol
    Range(cTarget).Offset(1, 1).Resize(cCol, cRow) = vntT

End Sub
Источник

ОБНОВЛЕНО:
Умножение записанных матриц с функцией листа MMULT:

Sub RecordedMatrixMultiplication()
'
' RecordedMatrixMultiplication Macro
' selects manually removed, as proposed by Ron Rosenfeld 
'
    Range("A2").Value = 1
    Range("A3").Value = 2
    Range("A2:A3").AutoFill Destination:=Range("A2:A21"), Type:=xlFillDefault
    Range("A2:A21").Copy
    Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
        SkipBlanks:= False, Transpose:=True
    Application.CutCopyMode = False
    Range("B2").FormulaR1C1 = "=MMULT(RC[-1]:R[19]C[-1],R[-1]C:R[-1]C[19])"
    Range("B2:U21").FormulaArray = "=MMULT(RC[-1]:R[19]C[-1],R[-1]C:R[-1]C[19])"
End Sub

Источник
Другие вопросы по тегам