1

我最近一直在研究数组以更快地将数据写入 Excel 以生成报告。

我遇到过这个,VBA 将 3 维数组粘贴到 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我的细胞作为输出

4

2 回答 2

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))... 将每个后续循环的 A1 偏移量为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

在此处输入图像描述

于 2013-06-20T13:15:23.570 回答
0

在您编辑的问题后回答。

 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
于 2013-06-20T09:02:36.450 回答