VBA: 如何使用 for 循环将数组添加到锯齿状数组

Question

想象一下下面的电子表格，但您不确定会有多少行：

现在您需要创建一个包含其他数组的数组（称为 ArticleArray），这样您的输出如下所示：

ArticleArray = {{"Fake Outlet 1","9/1/2020","Fake headline 1"},{"Fake Outlet 2","9/2/2020","Fake headline 2"},{"Fake Outlet 3","9/3/2020","Fake headline 3"}}

您可以在下面看到我已经编写的代码示例：

Sub Pull_News()

    Dim i As Long

    'Finding the last row of the news table and adding borders
    Dim lRow As Long
    lRow = Sheets("News Archive").Cells(Rows.Count, 1).End(xlUp).Row
    
    'Creating a jagged array that will storeeach article array
    Dim ArticleArray() As Variant

    'Lopping through each article and creating an array
    For i = 2 To lRow - 1
        
        'Creating a temporary news array
        Dim Article() As Variant
        
        'Filling Temporary Array
        Article = Sheets("News Archive").Range("A" & i & ":" & "C" & i).Value
        
        'Adding temporary array to the jagged array
            
        'change / adjust the size of array
        ReDim Preserve ArticleArray(1 To UBound(ArticleArray) + 1) As Variant
        
        ' add value on the end of the array
        ArticleArray(UBound(ArticleArray)) = Article
        
    Next i

End Sub

我在以下行收到以下错误消息：

ReDim Preserve ArticleArray(1 To UBound(ArticleArray) + 1) As Variant

Run-time error 9: Subscript out of range

Answer 1

Article 不是 Range，也没有 .Value。
ReDim Preserve 很贵。最好在循环外调整一次数组大小：

Dim ArticleArray() As Variant
ReDim ArticleArray(0 To lrow -2) 'size the array outside the loop

Dim j As Long

'Looping through each article and creating an array
For i = 2 To lRow
        
    'Creating a temporary news array
    Dim Article() As Variant
        
    'Filling Temporary Array
    Article = Sheets("News Archive").Range("A" & i & ":C" & i).Value
        
    'Adding temporary array to the jagged array
    ArticleArray(j) = Article
    j = j + 1
        
Next i

Answer 2

二维与锯齿状阵列

代码

Option Explicit

Sub Pull_News()
    
    ' Constants
    Const wsName As String = "News Archive"
    Const srcRange As String = "A:C"
    Const LastRowColumn As Long = 1
    Const FirstRow As Long = 2
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Define worksheet.
    Dim ws As Worksheet
    Set ws = wb.Worksheets(wsName)

    ' Calculate last row.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, _
                       ws.Range(srcRange).Columns(LastRowColumn).Column) _
                .End(xlUp).Row
    
    ' Define Source Range.
    Dim rng As Range
    Set rng = ws.Range(srcRange).Resize(LastRow - FirstRow + 1) _
                                .Offset(FirstRow - 1)
     
    ' Write values from Source Range to Source Array.
    Dim Data As Variant
    Data = rng.Value
    
    ' Write contents of Source Array to the Immediate window (CTRL+G).
    Dim i As Long
    Debug.Print "Source Array:"
    For i = 1 To UBound(Data, 1)
        Debug.Print Data(i, 1), Data(i, 2), Data(i, 3)
    Next i
    
    ' Define upper limits of arrays.
    Dim UB1 As Long
    UB1 = UBound(Data, 1)
    Dim UB2 As Long
    UB2 = UBound(Data, 2)
    
    ' Define jagged Articles Array.
    Dim Articles As Variant
    ReDim Articles(1 To UB1)

    ' Define Temporary Article Array.
    Dim TempArticle As Variant
    ReDim TempArticle(1 To 1, 1 To UB2)
    
    ' Copy values from Source Array to jagged Articles Array.
    Dim j As Long
    For i = 1 To UB1
        ' Copy values from Source Array to Temporary Article Array.
        For j = 1 To UB2
            TempArticle(1, j) = Data(i, j)
        Next j
        ' Copy Temporary Article Array to jagged Articles Array.
        Articles(i) = TempArticle
    Next i
    
    ' Write contents of jagged Articles Array to the Immediate window (CTRL+G).
    Debug.Print "Jagged Articles Array:"
    For i = 1 To UB1
        Debug.Print Articles(i)(1, 1), Articles(i)(1, 2), Articles(i)(1, 3)
    Next i
    
End Sub

VBA: 如何使用 for 循环将数组添加到锯齿状数组

VBA: How to add arrays to a jagged array using a for loop

arrays

excel

vba

variant

二维与锯齿状阵列