VBA Excel - 遍历大型数据集并查找某些行的平均值

Question

我对使用 VBA 写作非常陌生，并且正在努力完成以下任务。

我有一个包含多个工作表的工作簿，每个工作表都有大量数据（10000 行）。我能够很容易地删除我不需要的数据并且可以对数据进行排序。我剩下第 1 列 - 零件列表，第 4 列和第 5 列 - 计划时间和实际时间。

我想用这些数据做的是找到第 1 列中每个唯一值的第 4 列和第 5 列的平均值。我认为执行以下操作会最简单

1. 循环每个工作表
2. 对“零件”的数据进行排序
3. 创建变量数组
4. 每行循环
5. 如果上一行“Part”与当前行相同，则将该行的“Planned Time”和“Actual Time”添加到变量数组中
6. 如果上一行“Part”不同，则计算变量数组中数据的平均值
7. 将平均值及其独特的“部分”输出到结果表中

任何帮助将不胜感激。主要是如何使用变量数组以及如何执行检查以填充数组。谢谢。

Answer 1

标记，

我已经为你准备了这个 VBA 宏，它应该可以解决问题。该脚本将遍历您的所有工作表并将信息汇总到一个数组中（问你问）。然后将数组输出到结果表中。

注意：您需要确保您的工作簿包含一个名为“结果”的工作表。该脚本会将您需要的详细信息输出到“结果”表。

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

希望这会有所帮助！