Excel VBA 중첩 For 루프 문제

Question

시트 당 세 개의 값을 개별적으로 추출해야하는 60 개의 큰 데이터 세트가 있습니다. 이 값들은 하나의 시트에 요약되어 있으므로 데이터의 개요를 알 수 있습니다.

VBA에서 인터넷 크래시 과정을 수강하여 수동으로 수행하지 않으려 고 매크로를 작성했습니다. 내 생각은 (내가 코드를 번역 할 수 있었다) 시트 당 세 개의 셀을 2D 배열의 행에 복사하는 것이므로 새로 만든 시트에 복사 할 수있는 [60x3] 행렬로 끝낼 것입니다. 'Mean '. (나는 이것이 매우 비효율적이라고 생각하지만, 지금 당장 생각해 볼 수있는 최선의 방법입니다.)

코드는 실행되지만 바람직하지 않은 결과를 생성합니다. 행렬은 마지막 시트의 값의 세 쌍으로 만 구성됩니다. 내 매크로에서 실제로 필요한 것은 sheet1의 세 값을 복사하여 MeanTable (1, :)에 붙여 넣은 다음 sheet2에서 세 개의 값을 복사하여 MeanTable (2, :) 등으로 붙여 넣는 것입니다. 내 첫 번째 중첩 된 루프가 쓰레기이기 때문에 이것이 일어나고 있다고 확신하므로 다른 루프를 시도하고 루프 (그리고 웹 검색 과정)를 추가했지만 지금까지는 해결할 수 없었습니다.

Sub copy_to_one_sheet() 'copy sample means from each sheet to Means 
Application.ScreenUpdating = False 

Dim ws As Worksheet 
Dim NumSheets As Integer 
Dim NumSamples As Integer 
Dim MeanTable() As Long 'store sample means in this 2D array, its size defined by number of sheets and samples per sheet 
NumSheets = Application.Sheets.Count 'count number of sheets 
NumSamples = 3 'number of samples per sheet (hardcoded for now) 
ReDim MeanTable(NumSheets, 1 To NumSamples) 'MeanTable will be filled with sample means 

'============================================ 
'= copy sample means per sheet to MeanTable = 
'============================================ 
For i = 1 To UBound(MeanTable, 1) 'copy sample means from fixed columns per sheet to individual rows of Table array 

    For Each ws In ThisWorkbook.Worksheets 'go through sheets 

     MeanTable(i, 1) = ws.Cells(Rows.Count, 3).End(xlUp).Offset(-3, 0).Value 
     MeanTable(i, 2) = ws.Cells(Rows.Count, 10).End(xlUp).Offset(-3, 0).Value 
     MeanTable(i, 3) = ws.Cells(Rows.Count, 17).End(xlUp).Offset(-3, 0).Value 

    Next ws 
Next i 
'============================================= 
'= create Sheet("Means") and paste MeanTable = 
'============================================= 
With ThisWorkbook 
    Set Dst = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 'create new worksheet 
    Dst.Name = "Means" 'worksheet name 
    With Sheets("Means") 
     For k = 1 To UBound(MeanTable, 1) 
      For l = 1 To NumSamples 
       Cells(k, l).Value = MeanTable(k, l) 'paste Table variable with sample means to new worksheet ("Means") 
      Next l 
     Next k 
    End With 
End With 
End Sub 

내 질문은 : 어떻게 통합 문서의 각 시트를 통해 내 루프주기를하고 MeanTable의 해당 행에 대한 값의 삼중를 복사 할 수 있습니다, 다음 시트로 이동하기 전에?

도움이 될 것입니다.

Answer 1

For i = 1 To UBound(MeanTable, 1)은 카운터 i = i + 1로 교체 될 필요가있다. Range.Resize를 사용하여 배열의 범위를 채 웁니다.

Sub copy_to_one_sheet()        'copy sample means from each sheet to Means 
    Application.ScreenUpdating = False 

    Dim ws As Worksheet 
    Dim NumSheets As Integer 
    Dim NumSamples As Integer 
    Dim MeanTable() As Long       'store sample means in this 2D array, its size defined by number of sheets and samples per sheet 
    NumSheets = Application.Sheets.Count    'count number of sheets 
    NumSamples = 3         'number of samples per sheet (hardcoded for now) 
    ReDim MeanTable(1 To NumSheets, 1 To NumSamples) 'MeanTable will be filled with sample means 

    For Each ws In ThisWorkbook.Worksheets   'go through sheets 
     i = i + 1 
     MeanTable(i, 1) = ws.Cells(Rows.Count, 3).End(xlUp).Offset(-3, 0).Value 
     MeanTable(i, 2) = ws.Cells(Rows.Count, 10).End(xlUp).Offset(-3, 0).Value 
     MeanTable(i, 3) = ws.Cells(Rows.Count, 17).End(xlUp).Offset(-3, 0).Value 

    Next ws 

    With ThisWorkbook 
     Set Dst = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 'create new worksheet 
     Dst.Name = "Means"       'worksheet name 
     With Sheets("Means") 
      .Range("A1").Resize(UBound(MeanTable, 1), UBound(MeanTable, 2)).Value = MeanTable 

     End With 
    End With 
End Sub