避免在for循环中覆盖for循环vba

Question

我从excel中的可变数量的表格（第五个到最后一个）拉出值，其中每个值都包含可变数量的“条目”。例如。 “条目1”具有我想要的列F和H中的值。“条目2”具有我想要的列K和M等中的值（这些在代码的注释中也称为“引号”）。

我在For循环中使用For循环来完成此操作。我遇到的问题是，“parent”for循环的每次递归都会覆盖先前递归中创建的条目。我的代码说明：

Sub ListSheets() 

    ' Creating an integer that specifies the size of the arrays of column entries 
    ' and thus the maximum number of quotes. 
    Dim array_size As Integer 


    'Defining Arrays that will be used to select quantities of different quotes 
    '(e.g. Class) 
    'Region, Date and Price all have the same column entries, meaning only one array is 
    'required. 
    Dim Class_Cols_Array() As Integer 
    Dim RDP_Cols_Array() As Integer 

    'Resizing these arrays. This resize sets the maximum number of quotes per sheet to 
    '1000. 
    array_size = 1000 
    ReDim Class_Cols_Array(1 To array_size, 1 To 1) 
    ReDim RDP_Cols_Array(1 To array_size, 1 To 1) 

    'Setting the first entries as the corresponding column indexes of H and F 
    'respectively. 
    Class_Cols_Array(1, 1) = 8 
    RDP_Cols_Array(1, 1) = 6 

    ' Filling both arrays with column indexes of quotes. In both cases the row number is  
    'the same for each quote and thus 
    ' does not need to be specified for each entry. 
    For intLoop = 2 To 1000 
     Class_Cols_Array(intLoop, 1) = Class_Cols_Array(intLoop - 1, 1) + 5 
     RDP_Cols_Array(intLoop, 1) = RDP_Cols_Array(intLoop - 1, 1) + 5 
    Next 


    'Defining an array which will contain the number of entries/quotes (as defined by 
    ' the user) for each sheet/manufacturer. 
    Dim Num_of_Entries() As Integer 

    ' Resizing this array to match the number of manufacturers (sheets therein) within 
    'the workbook. 
    ReDim Num_of_Entries(1 To Worksheets.Count - 6, 1 To 1) 

    'Defining arrays that will contain will be populated with quote quantities (e.g. 
    'Class), pulled from cells. 
    Dim Class_Array() As String 
    Dim Region_Array() As String 
    Dim Date_Array() As String 
    Dim Price_Array() As String 
    Dim Manufacturer_Array() As String 



    'Here number of entries for each manufacturer (sheet) are pulled out, with this 
    'value being entered into the appropriate cell(B5) 
    'by the user. 
    Dim i As Integer 
    For i = 5 To Worksheets.Count - 2 
     j = i - 4 
     Num_of_Entries(j, 1) = ThisWorkbook.Worksheets(i).Cells(5, 2) 
    Next 



    'Creating an integer that is the total number of entries (that for all sheets 
    'combined). 
    Dim total_entries As Integer 
    total_entries = WorksheetFunction.Sum(Num_of_Entries) 

    'Setting the size of each quantity-containing array to match the total number of 
    'entries. 
    ReDim Class_Array(1 To total_entries, 1 To 1) 
    ReDim Region_Array(1 To total_entries, 1 To 1) 
    ReDim Date_Array(1 To total_entries, 1 To 1) 
    ReDim Price_Array(1 To total_entries, 1 To 1) 
    ReDim Manufacturer_Array(1 To total_entries, 1 To 1) 

    'Creating a variable for the numbers of entries for a specific sheet. 
    Dim entries_for_sheet As Integer 

    'Creating a variable for the sheet number for a specific sheet (e.g. "Acciona_Fake 
    'is the 5th sheet). 
    Dim sheet_number As Integer 

    'Looping over the sheets (only fifth to third from last sheets are of interest). 
    For sheet_number = 5 To Worksheets.Count - 2 

     'Creating an iterating value that starts at 1 in order to match sheets to their 
     'number of entries. 
     j = sheet_number - 4 
     entries_for_sheet = Num_of_Entries(j, 1) 

     'Looping over the entries for each sheet, extracting quote quantities and adding 
     'to their respective arrays. 
     For i = 1 To entries_for_sheet 
      Class_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6, 
      Class_Cols_Array(i, 1)) 
      Region_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6, 
      RDP_Cols_Array(i, 1)) 
      Date_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(8, 
      RDP_Cols_Array(i, 1)) 
      Price_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(41, 
      RDP_Cols_Array(i, 1)) 
      Manufacturer_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Name 
     Next 
    Next 



    'Exporting all arrays. 
    Sheets("vba_deposit").Range("A1").Resize(UBound(Class_Array)).Value = Class_Array 
    Sheets("vba_deposit").Range("B1").Resize(UBound(Region_Array)).Value = Region_Array 
    Sheets("vba_deposit").Range("C1").Resize(UBound(Date_Array)).Value = Date_Array 
    Sheets("vba_deposit").Range("D1").Resize(UBound(Price_Array)).Value = Price_Array 
    Sheets("vba_deposit").Range("D1").Resize(UBound(Manufacturer_Array)).Value =   
    Manufacturer_Array 
    End Sub 

底部在寻找循环中的for循环，我需要找到一个办法让方程（组）的RHS的迭代。例如。我需要我的价值是一样的，

ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1)) 

，而我需要的方程的LHS的我也与“父” for循环的每次运行增加。 I.E.我需要我成为“迄今为止的条目数”+我为

ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1)) 

我找不出一种方法来做到这一点。有没有办法追加一个数组，而不是将值分配给单个元素？ （这听起来很简单，但我已经搜索过，并且找不到真正的附加方法，只能分配给元素的循环）。

非常感谢提前。

Answer 1

编译，未经测试：

Sub ListSheets() 

    Dim intLoop As Long, i As Long, total_entries As Long 
    Dim sht As Worksheet, sheet_number As Long 
    Dim entries_for_sheet As Long 
    Dim classCol As Long, RDPCol As Long 
    Dim entry_num As Long 

    Dim Data_Array() As String 

    total_entries = 0 
    entry_num = 0 

    For sheet_number = 5 To Worksheets.Count - 2 

     Set sht = ThisWorkbook.Worksheets(sheet_number) 
     entries_for_sheet = sht.Cells(5, 2).Value 
     total_entries = total_entries + entries_for_sheet 

     'can only use redim Preserve on the last dimension... 
     ReDim Preserve Data_Array(1 To 5, 1 To total_entries) 

     classCol = 8 
     RDPCol = 6 

     For i = 1 To entries_for_sheet 
      entry_num = entry_num + 1 

      Data_Array(1, entry_num) = sht.Cells(6, classCol) 
      Data_Array(2, entry_num) = sht.Cells(6, RDPCol) ' 6? 
      Data_Array(3, entry_num) = sht.Cells(8, RDPCol) 
      Data_Array(4, entry_num) = sht.Cells(41, RDPCol) 
      Data_Array(5, entry_num) = sht.Name 

      classCol = classCol + 5 
      RDPCol = RDPCol + 5 
     Next 
    Next 

    Sheets("vba_deposit").Range("A1").Resize(UBound(Data_Array, 2), _ 
      UBound(Data_Array, 1)).Value = Application.Transpose(Data_Array) 
End Sub