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

Question

我正在尝试创建一个值数组，我从数据传播sheet 具有的 x 多个 sheet 中获得这些值。

目前这是我目前所拥有的


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

我附上了一张图片来显示我创建的假数据（为简单起见，每个 sheet 上的数据相同）

最后我想让一个名为 list 的数组具有相同数量的 z 列，但是值的行将被添加到彼此的下方，然后调整数组的大小并添加 sheet它来自.

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

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

Making one Array composed of multiple range values from different sheets in Excel VBA

arrays

excel

vba

dynamic-arrays