VBA Excel - 큰 데이터 세트를 반복하고 특정 행의 평균을 찾습니다.

Question

저는 VBA로 작성하는 데 매우 익숙하며 다음 작업으로 어려움을 겪고 있습니다.

각 (10000 개의 행)에 많은 수의 데이터가 포함 된 통합 문서가 여러 장 있습니다. 데이터를 쉽게 제거 할 수 있으며 데이터를 정렬 할 수 있습니다. 파트 1의 목록 인 열 1과 계획된 시간 및 실제 시간 4 및 5 열이 남았습니다.

은 내가이 데이터와 함께하고 싶은 것은 나는 그것이 각 워크 시트에 대해 다음

1. 루프를 수행하는 가장 쉬운 것이라고 생각 컬럼 1에서 각각의 고유 값에 대한 4 행의 평균 5를 찾을 수 있습니다 현재 행 다음에 추가로 이전 행 "부"는 해당 행의 "계획된 시간"같은 경우
2. 정렬 "부"
3. 을위한 데이터는 각 행
4. 에 대한 변수 배열
5. 루프 만들기 및 "Actu 부 "변수 배열
6. 이전 행이 경우에"알 시간 "다른 계산 변수 배열에있는 데이터의 평균
7. 출력 고유와 결과 시트에 평균"부 "

어떤 도움을 주시면 감사하겠습니다. 주로 변수 배열을 사용하는 방법과 배열을 채우기 위해 검사를 수행하는 방법. 고맙습니다. 내가 트릭을 할해야 당신이 VBA 매크로 함께로를 넣었습니다

Answer 1

마크. 스크립트는 모든 워크 시트를 반복하고 정보를 배열로 요약합니다 (요청한 질문에 답하십시오). 배열은 결과 테이블에 출력됩니다.

참고 : 통합 문서에 "결과"라는 시트가 포함되어 있는지 확인해야합니다. 스크립트는 필요한 세부 정보를 "결과"시트에 출력합니다.

Option Explicit 


Sub getResults() 

'set variables 
Dim ws As Worksheet 
Dim lastRow As Long 
Dim i As Long 
Dim ii As Long 
Dim partName As String 

'set array to contain the parts/avarage data 
Dim partsAverageArray() As Variant 
ReDim partsAverageArray(1 To 4, 1 To 1) 


'loop through each sheet in the workbook 
For Each ws In ActiveWorkbook.Sheets 

    'ignore worksheet if it's name is "Results" 
    If Not ws.Name = "Results" Then 

     'get last row in the sheet using column A (size of the table of parts) 
     lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 

     'loop down the table of parts data starting at row 2 (assuming that row 1 contains the heading of the columns 
     i = 2 
     For i = 2 To lastRow 

      'get the part name 
      partName = ws.Cells(i, 1).Value 

      'check if the part does/does not exist within the array yet 
      'loop through the array to get this info 

      'check if array has any info in it yet 
      If partsAverageArray(1, 1) = "" Then 
       'array is blank so add the first part 
       'add part name 
       partsAverageArray(1, 1) = partName 
       'part occurences 
       partsAverageArray(2, 1) = 1 
       'sum of time planned 
       partsAverageArray(3, 1) = ws.Cells(i, 4).Value 
       'sum of time taken (actual) 
       partsAverageArray(4, 1) = ws.Cells(i, 5).Value 

      Else 
       'array already exists so loop through it looking for a part match 
       ii = 1 
       For ii = 1 To UBound(partsAverageArray, 2) 
        'test for a part match 
        If partsAverageArray(1, ii) = partName Then 
         'match found 
         'so add/cumulate data into the array 
         'part occurences (add 1) 
         partsAverageArray(2, ii) = partsAverageArray(2, ii) + 1 
         'sum of time planned (total) 
         partsAverageArray(3, ii) = partsAverageArray(3, ii) + ws.Cells(i, 4).Value 
         'sum of time taken (actual) (total) 
         partsAverageArray(4, ii) = partsAverageArray(4, ii) + ws.Cells(i, 5).Value 

         'stop the loop of the array 
         ii = UBound(partsAverageArray, 2) 

        Else 
         'part name does not match 
         'check if the end of the array has been reached 
         If ii = UBound(partsAverageArray, 2) Then 
          'the end of the array has been reached and the part not found 
          'therefore add an additional dimension to the array and put the part's details into it 
          ReDim Preserve partsAverageArray(1 To 4, 1 To (UBound(partsAverageArray, 2) + 1)) 
          'add part name 
          partsAverageArray(1, UBound(partsAverageArray, 2)) = partName 
          'part occurences 
          partsAverageArray(2, UBound(partsAverageArray, 2)) = 1 
          'sum of time planned 
          partsAverageArray(3, UBound(partsAverageArray, 2)) = ws.Cells(i, 4).Value 
          'sum of time taken (actual) 
          partsAverageArray(4, UBound(partsAverageArray, 2)) = ws.Cells(i, 5).Value 

          'stop the loop of the array 
          ii = UBound(partsAverageArray, 2) 

         Else 
          'part name has not been found and the array has not looped to the end. 
          'therefore keep the array looping and do nothing 

         End If 

        End If 

       Next ii 

      End If 

     Next i 

    End If 

Next ws 




'-------------------------------------------------------- 
'output data from the array to the reults sheet 
'-------------------------------------------------------- 

Set ws = Sheets("Results") 
'set the results table headings 
ws.Cells(1, 1).Value = "Part" 
ws.Cells(1, 2).Value = "Part Count" 
ws.Cells(1, 3).Value = "Planned Time (Average)" 
ws.Cells(1, 4).Value = "Actual Time (Average)" 

'clear the old results from the table before adding the new results 
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 
ws.Range("A2:D" & lastRow).ClearContents 


i = 1 
For i = 1 To UBound(partsAverageArray, 2) 
    'part name 
    ws.Cells(i + 1, 1).Value = partsAverageArray(1, i) 
    'part count 
    ws.Cells(i + 1, 2).Value = partsAverageArray(2, i) 
    'average (planned) 
    ws.Cells(i + 1, 3).Value = partsAverageArray(3, i)/partsAverageArray(2, i) 
    'average (actual) 
    ws.Cells(i + 1, 4).Value = partsAverageArray(4, i)/partsAverageArray(2, i) 
Next i 

'view results 
ws.Activate 


End Sub 

희망이 있습니다.