创建从某些列到一列的数据摘要

Question

我有一个 5 列、1000 多行的 Excel 文件。 A 列是客户编码。 B 列是销售机器的年份。C 列是机器类型。D 列是销售数量。 E栏是税。 我想在一个单元格中创建一个摘要（例如在 I 列中），以显示每个鳕鱼在哪些年份购买哪些类型。每年的所有类型都可以放在括号中。例如 2023 年鳕鱼 1001 购买 D、B 型； 2022年购买C型； 2021 年购买 A 型。所以我的鳕鱼创建：2023(D, B); 2022（C）； 2021(A)

我附上我的代码（通过亲爱的VBasic2008的字典创建）及其结果。

Sub TransformData()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Write to source array.
    ' Reference the objects.
    Dim sws As Worksheet: Set sws = wb.Sheets("sheet1")
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    ' Write.
    Dim sData() As Variant:
    sData = srg.Value
   
    ' Write to the dictionary.
    ' Define.
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Declare additional variables.
    Dim r As Long, c As Long, cod As Variant, dabir As Variant, group As Variant
    ' Write.
    For r = 2 To UBound(sData, 1) '   ÊÚÏÇÏ ˜á ÓØÑ
        cod = sData(r, 1)   'cod(key)
          dabir = sData(r, 2)
          group = sData(r, 3)
        If Not dict.Exists(cod) Then
            Set dict(cod) = CreateObject("Scripting.Dictionary")
        End If
        If Not dict(cod).Exists(dabir) Then
            Set dict(cod)(dabir) = CreateObject("Scripting.Dictionary") ' string
            dict(cod)(dabir).CompareMode = vbTextCompare
        End If
        If Not dict(cod)(dabir).Exists(group) Then
            dict(cod)(dabir)(group) = Empty
        End If
    Next r

   ' Write to the destination array.

   ' Define (initialize).
    Dim dData() As Variant: ReDim dData(1 To dict.count + 1, 1 To 2)
    r = 1
'    ' Write headers.
    dData(1, 1) = sData(1, 1)
    dData(1, 2) = sData(1, 2) & DST_DATE_TYPE_DELIMITER & sData(1, 3)
    ' Declare additional variables.
    Dim cKey As Variant, dKey As Variant, dStr As String
    ' Write data.
    For Each cKey In dict.Keys
        r = r + 1
        dData(r, 1) = cKey
        For Each dKey In dict(cKey).Keys
            dStr = dStr & "; " & dKey & "(" & Join(dict(cKey)(dKey).Keys, ", ") & ")"
        Next dKey
        dStr = Right(dStr, Len(dStr) - Len("; "))
        dData(r, 2) = dStr
        dStr = vbNullString
    Next cKey
    ' Write to the destination range.
    ' Reference the objects.
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet1")
    Dim dfcell As Range: Set dfcell = sws.Range("H1")
    Dim drg As Range: Set drg = dfcell.Resize(r, 2)
    ' Write.
    drg.Value = dData
    ' Clear below.
    drg.Resize(dws.Rows.count - drg.Row - r + 1).Offset(r).Clear
    ' Format.
    With drg
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
    End With

End Sub

我的结果在绿色区域

现在我想在括号中添加计数求和和税收求和。例如 cod:1001 在 2023 年购买 7 个 D 型和 -2 个 B 型。因此 2023 年 cod 1001 的计数总和为 7+(-2)=5。还有税收。 2023 年鳕鱼 1001 的税金总额为 200,000 + 35,000=235,000。所以结果我需要这个来处理 cod 1001:

2023（D，B）[计数=5，税=235,000]； 2022(C)[计数=2，税=20,000]； 2021(A)[计数=3，税=150,000]

我在结果中附上了需要的样本（绿色区域）。

Answer 1

我该怎么做？有人有想法吗？？？