如何将VBA三维数组的指定切片直接赋值到单元格区域？

原本使用二维数组arrMyArray(1 To 12, 1 To x)可直接赋值到单元格区域，现在升级为三维数组arrMyArray(1 To 12, 1 To x, 1 To 2)存储额外关联数据，希望直接将arrMyArray(1 To 12, 1 To x, 1)部分赋值到单元格区域，避免逐个赋值的低效循环操作（涉及4个类似数组，x最大为10）。

现有数组填充逻辑 #

arrMonthsMA(1) = "apr"
arrMonthsMA(2) = "may"
arrMonthsMA(3) = "jun"
arrMonthsMA(4) = "jul"
arrMonthsMA(5) = "aug"
arrMonthsMA(6) = "sep"
arrMonthsMA(7) = "oct"
arrMonthsMA(8) = "nov"
arrMonthsMA(9) = "dec"
arrMonthsMA(10) = "jan"
arrMonthsMA(11) = "feb"
arrMonthsMA(12) = "mar"

arrYearsMA(1) = arrYearOneMA
arrYearsMA(2) = arrYearTwoMA
arrYearsMA(3) = arrYearThreeMA
arrYearsMA(4) = arrYearFourMA
arrYearsMA(5) = arrYearFiveMA

For i = 1 To UBound(arrYearsMA())
    For j = 1 To iNumberOfAccountsMA
        For k = 1 To 12 'The months
            'Transaction values
            If iCount = 0 Then sSearch = "cy" & "_" & arrMonthsMA(k) & "_transaction_value"
            If iCount <> 0 Then sSearch = "cy" & iCount & "_" & arrMonthsMA(k) & "_transaction_value"
                            
            Set rngToFind = .Cells.Find(what:=sSearch, SearchOrder:=xlByColumns)
            arrYearsMA(i)(k, j, 1) = rngToFind.Offset(, j).Value2
                            
            'Transaction count
            If iCount = 0 Then sSearch = "cy" & "_" & arrMonthsMA(k) & "_transaction_count"
            If iCount <> 0 Then sSearch = "cy" & iCount & "_" & arrMonthsMA(k) & "_transaction_count"
                            
            Set rngToFind = .Cells.Find(what:=sSearch, SearchOrder:=xlByColumns)
            arrYearsMA(i)(k, j, 2) = rngToFind.Offset(, j).Value2
                            
            If k = 12 And j = iNumberOfAccountsMA Then iCount = iCount - 1
        Next k
    Next j
Next i

原二维数组赋值逻辑 #

For i = 1 To UBound(arrYearsMA())
    With rngToFind.Offset((13 * iOffsetMA) + (13 * (i - 1)), 1)
        Range(.Offset(, 0), .Offset(11, iNumberOfAccountsMA - 1)).Value = arrYearsMA(i)
    End With
Next i

解决方案 #

VBA不支持直接将三维数组的切片赋值到单元格区域，但可通过辅助函数快速将三维数组指定维度的切片转换为二维数组，再直接赋值到区域，这种方式比逐个单元格循环高效得多。

辅助函数实现 #

Function Get3DSlice(arr As Variant, sliceIndex As Integer) As Variant
    Dim rowStart As Integer, rowEnd As Integer
    Dim colStart As Integer, colEnd As Integer
    Dim i As Integer, j As Integer
    
    ' 获取原三维数组的行列边界
    rowStart = LBound(arr, 1)
    rowEnd = UBound(arr, 1)
    colStart = LBound(arr, 2)
    colEnd = UBound(arr, 2)
    
    ' 初始化二维数组
    Dim result As Variant
    ReDim result(rowStart To rowEnd, colStart To colEnd)
    
    ' 复制切片数据到二维数组
    For i = rowStart To rowEnd
        For j = colStart To colEnd
            result(i, j) = arr(i, j, sliceIndex)
        Next j
    Next i
    
    Get3DSlice = result
End Function

修改后的赋值逻辑 #

调用辅助函数提取arrYearsMA(i)的第1个三维切片，再直接赋值到目标区域：

For i = 1 To UBound(arrYearsMA())
    With rngToFind.Offset((13 * iOffsetMA) + (13 * (i - 1)), 1)
        Dim slice2D As Variant
        slice2D = Get3DSlice(arrYearsMA(i), 1)
        Range(.Offset(, 0), .Offset(11, iNumberOfAccountsMA - 1)).Value = slice2D
    End With
Next i

说明 #

• 辅助函数仅在内存中操作数组，比循环写入单元格快很多，即使x=10，每个数组仅需120次内存操作，远低于逐个单元格的IO操作开销。
• 若需要提取第2个切片（交易计数），只需将sliceIndex参数改为2即可。

内容的提问来源于stack exchange，提问作者David Vinnicombe