将2个数组乘以第三个空白数组范围VBA（Excel）

Question

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

很难找出循环。

Answer 1

对工作表的读写效率低下。最好在 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

Answer 2

坚持使用您可以使用的 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

Answer 3

数组乘法表

根据需要更改 Constants 部分中的值。

代码

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

Answer 4

vba计算的mmult结果：

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

Answer 5

更新：
使用工作表函数 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