避免在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