以下是一个示例代码,可以实现对四个条件进行分类汇总:

Sub SummarizeData()

Dim LastRow As Long
Dim i As Long, j As Long
Dim wsSource As Worksheet, wsDest As Worksheet
Dim sKey As String
Dim dData As Double
Dim dict As Object

'设置源工作表和目标工作表
Set wsSource = ThisWorkbook.Sheets("Sheet1")
Set wsDest = ThisWorkbook.Sheets.Add

'复制表头
wsSource.Rows(1).Copy wsDest.Rows(1)

'获取源数据最后一行
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

'创建字典对象
Set dict = CreateObject("Scripting.Dictionary")

'循环源数据
For i = 2 To LastRow
    '生成键值
    sKey = wsSource.Cells(i, "B").Value & "-" & wsSource.Cells(i, "C").Value & "-" & wsSource.Cells(i, "D").Value & "-" & wsSource.Cells(i, "E").Value
    '获取数据值
    dData = wsSource.Cells(i, "F").Value
    '如果键已存在,则累加数据值
    If dict.Exists(sKey) Then
        dict(sKey) = dict(sKey) + dData
    Else
        '否则,添加新键值对
        dict.Add sKey, dData
    End If
Next i

'将字典中的数据写入目标工作表
For i = 0 To dict.Count - 1
    '获取键和值
    sKey = dict.Keys()(i)
    dData = dict.Items()(i)
    '按照条件拆分键值
    j = 1
    For Each s In Split(sKey, "-")
        wsDest.Cells(2 + i, j).Value = s
        j = j + 1
    Next s
    '将汇总结果写入目标工作表
    wsDest.Cells(2 + i, j).Value = dData
Next i

'调整列宽和格式
wsDest.Cells.EntireColumn.AutoFit
wsDest.Cells(2, 6).NumberFormat = "#,##0.00"

End Sub

这个代码将会把分类汇总结果放在一个新工作簿中的Sheet1工作表里,汇总结果放在第6列。如果需要更改输出结果的位置,可以修改代码中的wsDest.Cells(2 + i, j).Value = s 和 wsDest.Cells(2 + i, j).Value = dData这两行代码。


原文地址: https://www.cveoy.top/t/topic/96z 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录