如果您想使用字典使用 VBA 来执行此操作,您可以尝试以下代码。我拿了你的示例数据并假设它们从 A1 开始在 sheet1 中。您需要根据需要修改代码。
主模块
Option Explicit
Public Sub CreateReport()
' Turn off functionality such as auto calculations
'TurnOffFunctionality
' Read the data into a dictionary
Dim dict As Scripting.Dictionary
Set dict = ReadFromData()
' write the data to the report worksheet
WriteReport dict
' Turn functionality back on
'TurnOnFunctionality
End Sub
数据读取模块
Option Explicit
Const COL_DATA_NAME = 1
Const COL_VALUE1 = 2
Const COL_VALUE2 = 3
Const COL_ADD = 4
Function ReadFromData() As Scripting.Dictionary
On Error GoTo EH
Dim dict As New Scripting.Dictionary
' Get the data range
Dim rgData As Range
Set rgData = Sheet1.Range("A1:D7") ' asumption data is in A1:D7
Dim FirstName As String
Dim value1 As Long, value2 As Long
Dim nameCalcs As Calcs
Dim add As Boolean
' Go through each row
Dim rgCurRow As Range
For Each rgCurRow In rgData.Rows
' Read the row data to variables
FirstName = rgCurRow.Cells(1, COL_DATA_NAME)
value1 = rgCurRow.Cells(1, COL_VALUE1)
value2 = rgCurRow.Cells(1, COL_VALUE2)
add = rgCurRow.Cells(1, COL_ADD)
' If FirstName one is not already in dictionary then add
If Not dict.Exists(FirstName) Then
Set nameCalcs = New Calcs
dict.add FirstName, nameCalcs
End If
' Update the data holder for each FirstName with new values based on the current values
If add Then
dict(FirstName).Sum1 = dict(FirstName).Sum1 + value1
dict(FirstName).Sum2 = dict(FirstName).Sum2 + value2
End If
Next rgCurRow
Set ReadFromData = dict
Done:
Exit Function
EH:
' Your error message
End Function
数据写入模块
Option Explicit
Const REP_COL_FNAME = 1
Const REP_COL_SUM1 = 2
Const REP_COL_SUM2 = 3
Public Sub WriteReport(dict As Scripting.Dictionary)
On Error GoTo EH
' Clear the Report area
'ClearReportArea You need to do that on your own
' Write the report data
WriteDataToReport dict
Done:
Exit Sub
EH:
MsgBox Err.Description & ". Procedure is: Report_Write.TurnOnFunctionality."
End Sub
Private Sub WriteDataToReport(dict As Scripting.Dictionary)
On Error GoTo EH
' Get variable to track the rows
Dim rowCnt As Long
rowCnt = 1
' Go through each FirstName in the dictionary
Dim k As Variant
For Each k In dict.Keys
' Write the data to the report sheet from the data holder
Dim rgStart As Range
Set rgStart = Sheet1.Range("F1")
With dict(k)
rgStart.Offset(rowCnt, REP_COL_FNAME) = k
rgStart.Offset(rowCnt, REP_COL_SUM1) = .Sum1
rgStart.Offset(rowCnt, REP_COL_SUM2) = .Sum2
End With
rowCnt = rowCnt + 1
Next k
Done:
Exit Sub
EH:
' Your error mesaage
End Sub
还有 Calcs 类
Option Explicit
Public Sum1 As Long
Public Sum2 As Long