创建多个工作表以转储数组数据

时间:2019-02-26 11:37:13

标签: excel vba excel-2007

请参阅下面的代码,当我遇到困难时,需要对其进行调整。

有一个数组m3a,其中包含大量数据,代码完成后,该数据将转储到新工作表中。如果数据超过excel中的最大行数(1048576),它将在新数组m4a中添加前1048575个数据并转储。我想知道,如果数据超过了,如何创建多张纸(两张纸,三张纸等等,具体取决于数组中的行数。请帮助我调整这段代码

iLines = 3
startCalc = True
If startCalc Then
  Worksheets.Add After:=Worksheets(Worksheets.Count)
   Set sh = ActiveSheet
   If UBound(m3a, 1) <= Rows.Count Then
    sh.Range("A1").Resize(cnt, iLines + 1).Value = m3a
   Else
     ReDim m4a(1 To 1048575, 1 To iLines + 1)

       For i = 1 To 1048575
         For j = 1 To iLines + 1

            m4a(i, j) = m3a(i, j)
         Next j
       Next i
       sh.Range("A1").Resize(1048575, iLines + 1).Value = m4a
   End If
End If

1 个答案:

答案 0 :(得分:1)

也许这个例子会有所帮助。我正在使用较小的数组105个元素,并且一次移动10行,因此这给出10张10行的表格和1张5行的表格。您无需像已有阵列那样填充阵列。一百万行会使我的工作系统瘫痪。祝你好运...

编辑:已更新2D阵列。

Sub x()

Dim v(1 To 105, 1 To 2), i As Long, j As Long, ws As Worksheet, n As Long

n = 10 'number of rows transferred to each sheet

For i = LBound(v, 1) To UBound(v, 1) 'populating array just for this example
    v(i, 1) = i
    v(i, 2) = i * i
Next i

Do
    If UBound(v, 1) - j <= n Then n = UBound(v, 1) - j
    Set ws = Worksheets.Add
    ws.Range("A1").Resize(n, 2).Value = Application.Index(v, Evaluate("row(" & j + 1 & ":" & n + j & ")"), Array(1, 2))
    j = j + n
    If j >= UBound(v, 1) Then Exit Sub
Loop

End Sub