从范围联合创建变体数组的问题

Answer 1

像这样：

Sub ArrayTest()
    
    Dim ws As Worksheet
    Dim arr, lrow As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lrow = ws.Cells(Rows.Count, "C").End(xlUp).Row
    
    arr = GetArray(ws.Range("G3:G" & lrow), ws.Range("J3:O" & lrow), _
                   ws.Range("AD3:AE" & lrow), ws.Range("AI3:AI" & lrow))
        
    With ThisWorkbook.Worksheets("Sheet2").Range("B2")
        .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
         
End Sub

'Given a number of input ranges each consisting of one or more columns (assumed all input ranges have
'  the same # of rows), return a single 1-based 2D array with the data from each range
Function GetArray(ParamArray sourceCols() As Variant) As Variant
    Dim arr, rng, numCols As Long, numRows As Long, r As Long, c As Long, tmp, col As Long
    
    numRows = sourceCols(0).Rows.Count
    'loop over ranges and get the total number of columns
    For Each rng In sourceCols
        numCols = numCols + rng.Columns.Count
    Next rng
    
    ReDim arr(1 To numRows, 1 To numCols) 'size the output array
    c = 0
    For Each rng In sourceCols        'loop the input ranges
        tmp = As2DArray(rng)          'get range source data as array ####
        For col = 1 To UBound(tmp, 2) 'each column in `rng`
            c = c + 1                 'increment column position in `arr`
            For r = 1 To numRows      'fill the output column
                arr(r, c) = tmp(r, col)
            Next r
        Next col
    Next rng
    GetArray = arr
End Function

'Get a range's value, always as a 2D array, even if only a single cell
Function As2DArray(rng)
    If rng.Cells.Count > 1 Then
        As2DArray = rng.Value
    Else
        Dim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
        As2DArray = arr
    End If
End Function