使用Range在Array到Excel输出中的2D数组

Question

我最近一直在研究数据库，以便更快地将数据写入Excel以用于报告。

我遇到过这个，VBA pasting 3 dimensional array into sheet，它似乎适合我想做的事情。但是，我想在只有一（1）张。

中进行此操作

Dim arr(1 To 3)

Dim a As Integer
Dim x As Integer
Dim y As Integer

For a = 1 To 3
    ReDim inner(1 To 5, 1 To 5)

    'don't worry...makes a copy
    arr(a) = inner

    For x = 1 To 5
        For y = 1 To 5
            arr(a)(x, y) = a * x * y
        Next
    Next

    Sheets(a).Select    
    Range(Cells(1, 1), Cells(5, 5)) = arr(a)
Next

是否可以在没有循环的情况下将 arr 输出到excel范围内？ 类似的东西：
 Range(Cells(1, 1), Cells(5, 5*3)) = arr

预期产出：

  

1 1 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3

     

1 1 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3

     

1 1 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3

     

1 1 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3

     

1 1 1 1 1 - 2 2 2 2 2 - 3 3 3 3 3

我试着去购买我的单元格#N/A作为输出

Answer 1

您可以使用以下数组执行此操作

这一行

Sheets(1).[a1].Offset(0, UBound(inner) * (lngCnt - 1)).Resize(UBound(inner, 1), UBound(inner, 2)) = arr(lngCnt) 说

• Sheets(1).[a1] ....从Sheet1 A1
开始
• Resize(UBound(inner, 1), UBound(inner, 2)) ...每个后续循环的偏移量为inner的大小（即5，因此第二个循环适用于F1，第三个循环适用于K1 ）
• Resize(UBound(inner, 1), UBound(inner, 2)) ...转储到等于inner大小的范围（即5 * 5）

<强>码

Dim arr(1 To 3)
Dim a As Long
Dim x As Long
Dim y As Long
Dim lngCnt As Long

For a = 1 To 3
    ReDim inner(1 To 5, 1 To 5)
    arr(a) = inner
    For x = 1 To 5
        For y = 1 To 5
            arr(a)(x, y) = a * x * y
        Next
    Next
Next

For lngCnt = 1 To UBound(arr)
    Sheets(1).[a1].Offset(0, UBound(inner) * (lngCnt - 1)).Resize(UBound(inner, 1), UBound(inner, 2)) = arr(lngCnt)
Next

Answer 2

在您编辑的问题后回答。

 Dim sheetNo As Integer
   sheetNo = 1
   Sheets(sheetNo).Select

   Dim startRow As Integer
   Dim endRow As Integer
   Dim startCol As Integer
   Dim endCol As Integer
   Dim totCols As Integer
   Dim lastCol As Integer
   Dim firstCol As Integer
   totCols = 5
   startRow = 2
   endRow = 5
   firstCol = 3
   For curRow = startRow To endRow
      lastCol = firstCol
      For a = 1 To 3
         startCol = lastCol + 1
         endCol = startCol + totCols
         For curCol = startCol To endCol
           ActiveSheet.Cells(curRow, curCol).Value = a
         Next
         endCol = endCol + 1
         If (a < 3) Then
            ActiveSheet.Cells(curRow, endCol).Value = "-"
         End If
         lastCol = endCol
      Next
   Next