我很想在VBA写作并且正在努力完成以下任务。
我有一个包含多个工作表的工作簿，每个工作表中包含大量数据（10000行）。我能够很容易地删除我不需要的数据，并可以对数据进行排序。我留下了第1列 - 部件列表，以及第4和第5列 - 计划时间和实际时间。
我想对这些数据做些什么，就是找到第1列中每个唯一值的第4列和第5列的平均值。我认为最简单的方法是执行以下操作
任何帮助将不胜感激。主要是如何使用变量数组以及如何执行检查来填充数组。谢谢。
答案 0 :(得分：0)
标记，
我已经把这个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
希望这有帮助！