做个vba四条件分类汇总bcde四列为条件f列为数值列对相同的bcde进行f列数据汇总结果新建1个workbook把分类汇总结果放在新工作簿bcde放条件f列为汇总结果
以下是一个示例代码,可以实现对四个条件进行分类汇总:
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 著作权归作者所有。请勿转载和采集!