为什么我不能简单地阅读表格并将所有内容合并到一个变体中？

Question

我希望你一切都好。 上下文：我正在尝试在 VBA / Excel 中读取多个大工作表的内容（总共约 100k 行）并将其存储在 Variant 中，以便处理内存中的数据。

为什么：我想在内存中处理这些数据以提高速度，而不是直接在纸上工作和书写

我的代码在一张纸上运行良好，当有多于一张纸时问题就开始了。

问题：我想将不同工作表的内容合并到一个变体中，以便对其进行处理

代码：

Dim ws As Worksheet
Dim arrData As Variant ' The variant to store the data
Dim lastSheetLine As Double
Dim lineMemory As Double

lineMemory = 0

For Each ws In ThisWorkBook.Worksheets ' Parse all the sheets

     lastSheetLine = Worksheets(ws.name).Cells(Worksheets(ws.name).Rows.Count, "A").End(xlUp).Row ' find the last line of the sheet

   If lineMemory = 0 Then
     arrData(0, 15) = Worksheets(ws.name).Range("A2:O" & lastSheetLine).Value ' Store the sheet on the Variant
     lineMemory = lastSheetLine
   Else
     lineMemory = lineMemory + lastSheetLine ' Increment to get the position where to put the block
     arrData(lineMemory, 15) = Worksheets(ws.name).Range("A2:O" & lastSheetLine).Value
   End If

Next ws

关于这个多维数组，第二维始终为 15（列数始终相同），它是第一维，会随着工作表的不同而变化。

提前非常感谢您的帮助，我愿意接受一切

Answer 1

要合并具有相同列数的数组，请尝试以下方法：

1. 在标准模块顶部声明变量（在声明区域中）：

  Private arrFin()

3. 复制同一标准模块中的下一个代码：

Sub TestMrgeArrays()
 Dim wb As Workbook, ws As Worksheet, lastRow As Long

 Set wb = ThisWorkbook
 For Each ws In wb.Worksheets ' Parse all the sheets
     lastRow = ws.cells(ws.rows.count, "A").End(xlUp).row ' find the last line of the sheet
     merge2DArrays ws.Range("A2:O" & lastRow).Value ' merge with the final one...
 Next ws
 Debug.Print Bound(arrFin), UBound(arrFin, 2): Stop
End Sub

Sub merge2DArrays(arr)
    Dim arrNew(), i As Long, j As Long, xF As Long
    
    If Not Not arrFin Then
        If UBound(arrFin, 2) <> UBound(arr, 2) Then MsgBox "Different number of columns...": Exit Sub
        ReDim arrNew(1 To UBound(arrFin) + UBound(arr), 1 To UBound(arrFin, 2))
        xF = UBound(arrFin)
        For i = 1 To UBound(arrNew)
            For j = 1 To UBound(arrNew, 2)
                If i <= xF Then
                    arrNew(i, j) = arrFin(i, j)
                Else
                    arrNew(i, j) = arr(i - xF, j)
                End If
            Next j
        Next i
        arrFin = arrNew
    Else
        arrFin = arr: Exit Sub
    End If
End Sub

还有另一个涉及

ReDim Preserve

的选项，它可以获取先前加载的数组，转置它并将内容放入新数组中，仅使用新数组内容加载它，最后使最终数组与此（临时）数组相等。但是

Transpose

在范围维度方面有一些限制，在你的情况下它会失败。我还可以进行非标准函数转置而不会出现错误，但它也需要迭代......

Answer 2

您可以将范围内的值读入 Variant 变量中。如果该范围仅包含一个单元格，则 Variant 将获取该值。如果范围包含多个单元格，则 Variant 将是二维数组。

读取的目的地必须是一个变体。它不能是预定义的数组：

ReDim a(1 To 10, 1 To 15) 
' This will give a runtime error 13 (Type mismatch)
a = ThisWorkbook.Sheets(1).Range("A1:O10").Value

Dim b()
' This will give a runtime error 13 (Type mismatch)
b = ThisWorkbook.Sheets(1).Range("A1:O10").Value

Dim c As Variant
' Only this is okay:
c = ThisWorkbook.Sheets(1).Range("A1:O10").Value

因此，您无法将 Range 的数据读入预定义数组的一部分（除非 Range 仅包含单个单元格）。

所以如果你真的需要一个包含all工作表的all数据的大数组，你需要自己创建这个数组。

---

下面的代码将把每张sheet的数据分别读取到一个二维数组的集合中。读取时，会计算总大小。

读取完成后，我们知道最终的数组需要有多大。创建一个数组，并将所有数据逐个、逐个值地复制到其中。

Dim ws As Worksheet
Dim Data As New Collection
Dim totalRows As Long

' Step 1: Read data of every sheet into separate arrays
For Each ws In ThisWorkbook.Worksheets ' Parse all the sheets

    Dim lastSheetLine As Long
    lastSheetLine = ws.Cells(ws.Rows.Count, "A").End(xlUp).row ' find the last line of the sheet
    Data.Add ws.Range("A2:O" & lastSheetLine).Value, ws.Name
    totalRows = totalRows + (lastSheetLine - 1)
Next

' Now Copy all data into one big array
ReDim AllInOneData(1 To totalRows, 1 To 15)
Dim allInOneRow As Long, sheetIndex As Long, row As Long, col As Long
For sheetIndex = 1 To Data.Count
    For row = 1 To UBound(Data(sheetIndex), 1)
        allInOneRow = allInOneRow + 1
        For col = 1 To UBound(Data(sheetIndex), 2)
            AllInOneData(allInOneRow, col) = Data(sheetIndex)(row, col)
        Next col
    Next row
Next sheetIndex

请注意，当

Worksheets(ws.name).Cells

已经是工作表时，您不需要编写

ws

。只需写

ws.Cells

。