使一个数组由Excel VBA中不同工作表的多个范围值组成

Question

我正在尝试创建一个值数组，该值是我从x数据电子表格所具有的许多工作表中获得的。

目前为止，这是我目前所拥有的

Sub Test()

Workbooks.Open("dataex.xlsx").Activate
Dim i, x, y, z, sheet_num

Dim allsheets As Variant

Dim sheet As Variant
Dim sheets As Variant '

Dim list As Variant

Dim ws As Worksheet
i = Application.sheets.Count

x = 1
ReDim allsheets(1 To i)

For Each ws In Worksheets
    allsheets(x) = ws.Name
    x = x + 1
Next ws

sheets = allsheets
For Each sheet In sheets

tmp = Range("A2").CurrentRegion.Value

y = Range("A1").CurrentRegion.Rows.Count
z = Range("A1").CurrentRegion.Columns.Count

list = Range(Cells(1, 1), Cells(y, z))

Next sheet

End Sub

我已附上一张图片，以显示我创建的假数据（为简单起见，每张纸上都有相同的数据）https://i.stack.imgur.com/u4m2u.png

[最后，我想获得一个名为list的数组，该数组具有相同的z列数，但是值的行将被添加在彼此之间，然后调整数组的大小并添加其来自的图纸。

https://i.stack.imgur.com/9neZv.png

Answer 1

我之前做过类似的事情，看起来像这样：

Sub Test()

    Dim i As Long, wb As Workbook, data(), numSheets As Long
    Dim rng As Range, numCol As Long, totRows As Long, allData()
    Dim rw As Long, col As Long, arr, r As Long, firstSheet As Boolean

    Set wb = Workbooks.Open("dataex.xlsx")
    numSheets = wb.Worksheets.Count

    ReDim data(1 To numSheets)
    firstSheet = True 'controls whether we skip the header row

    'loop over the sheets and collect the data
    For i = 1 To numSheets
        Set rng = wb.Worksheets(i).Range("A1").CurrentRegion
        'ignore empty sheets
        If Application.CountA(rng) > 0 Then
            'remove the header if not first sheet
            If Not firstSheet Then Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
            data(i) = rng.Value                     'collect the data
            totRows = totRows + UBound(data(i), 1)  'add the row count
            firstSheet = False 'done one sheet
        End If
    Next i

    'size the final output array
    ReDim allData(1 To totRows, 1 To UBound(data(1), 1))

    r = 1
    'combine the array from each sheet into the final array
    For i = 1 To numSheets
        If Not IsEmpty(data(i)) Then 'sheet had data?
            arr = data(i)
            For rw = 1 To UBound(arr, 1)
                For col = 1 To UBound(arr, 2)
                    allData(r, col) = arr(rw, col)
                Next col
                r = r + 1
            Next rw
        End If
    Next i

    'add a new sheet and dump the array
    With wb.sheets.Add(after:=wb.sheets(wb.sheets.Count))
        .Range("A1").Resize(totRows, UBound(allData, 2)).Value = allData
    End With

End Sub