for 루프 내에서 for 루프를 덮어 쓰지 않기

Question

가변 개수의 "항목"이 포함 된 excel (마지막 다섯 번째에서 세 번째까지) 내의 가변 개수의 시트에서 값을 추출합니다. E.G. "엔트리 1"에는 필자가 원하는 열의 값이 있습니다. "엔트리 2"는 열 K 및 M 등에서 원하는 값을 갖습니다 (코드에 대한 주석에서 "따옴표"라고도 함).

For 루프 내에서 For 루프를 사용하고 있습니다. 내가 가지고있는 문제는 "부모"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의 반복을 유지하는 방법을 찾을 필요가있다. E.G. I는 I는 루프 용 "부모"의 각 실행 증가하는 식의 LHS에서 제가

필요 반면

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

대해 동일하게 상기 I 값이 필요하다. 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