Excel VBA：调整数组数组中子数组的大小，而不为每个子数组声明变量

Question

我在剪贴板中有一个制表符分隔的二维数据（从远程系统上的另一个 Excel 文件复制），它包含大约 20 列并且可以包含任意数量的行。

我想将数据读入一个VBA数组数组，其中每个子数组代表剪贴板中二维数据中一列的完整数据。 objective是将数据粘贴到本地Excel文件中，该文件有一些隐藏列，粘贴时跳过隐藏列。我想使用数组数组的方法，这样在粘贴时，我可以将整个列子数组分配给 Excel 范围。

我声明了一个包含 20 列的数组：

Dim allColsData(20) As Variant

但我不想为每个子数组列声明 20 个变量，我需要在将剪贴板中的每一行添加到此数组 allColsData 时动态调整其大小。

我是 Excel VBA 的新手，需要有关如何在不声明 20 个数组变量的情况下通过动态调整每个子数组的大小来填充数组 allColsData 的帮助。

我的问题是：

在不为每个子数组声明变量的情况下调整 allColsData 的每个子数组大小的语法是什么？

我可以管理从剪贴板读取并解析为二维数组的代码，首先根据新行拆分，然后根据制表符拆分每一行。

Answer 1

我剪贴板列

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Tests the JagClipBoardColumns function.
' Calls:        JagClipBoardColumns
'                   RefColumn,GetRange.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub JagClipBoardColumnsTEST()
    
    Dim cData As Variant: cData = JagClipBoardColumns
    If IsEmpty(cData) Then Exit Sub
    
    Dim c As Long
    
    For c = 1 To UBound(cData)
        Debug.Print "Array " & c & " has " & UBound(cData(c)) & " rows."
    Next c

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Adds a new one-worksheet workbook and pastes the contents
'               of the clipboard starting with cell 'A1'. Returns the values
'               of each column from a given row ('FirstRow') to the bottom-most
'               non-empty row in a 2D one-based array of a jagged array
'               finally closing the workbook.
' Calls:        RefColumn,GetRange.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function JagClipboardColumns( _
    Optional ByVal FirstRow As Long = 1) _
As Variant
    Const ProcName As String = "JagClipboardColumns"
    On Error GoTo ClearError
    
    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = Workbooks.Add(xlWBATWorksheet) ' one worksheet
    Dim ws As Worksheet: Set ws = wb.Worksheets(1)
    
    ws.PasteSpecial Format:="Unicode Text"
    
    Dim rg As Range: Set rg = ws.UsedRange
    
    Dim cCount As Long: cCount = rg.Columns.Count
    Dim cData As Variant: ReDim cData(1 To cCount)
    
    Dim crg As Range
    Dim c As Long
    
    For c = 1 To cCount
        Set crg = RefColumn(ws.Cells(FirstRow, c))
        cData(c) = GetRange(crg)
    Next c
        
    wb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True

    JagClipboardColumns = cData

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range from the first cell
'               of a range ('FirstCell') to the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "RefColumn"
    On Error GoTo ClearError
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of a range ('rg') in a 2D one-based array.
' Remarks:      If ˙rg` refers to a multi-range, only its first area
'               is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
    ByVal rg As Range) _
As Variant
    Const ProcName As String = "GetRange"
    On Error GoTo ClearError
    
    If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
        Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        GetRange = Data
    Else ' multiple cells
        GetRange = rg.Value
    End If

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

Excel VBA：调整数组数组中子数组的大小，而不为每个子数组声明变量

Excel VBA: Resize sub arrays within an array of arrays without declaring variable for each sub array

excel

vba

jagged-arrays

我剪贴板列