求VBA分类汇总代码
如上图，A列是辅助，得到的是序号，可以不用，BCDEF列是用公式得到的数据，并随时可改变，可能某行都是空值（不可能出现某行只有一个数据的情况）
BC的值如有需要可互换。数据有300多行。
现在要达到以下目的（可以使用任何多个辅助）：
1：先按材料Ab进行分类，并且ABCdf值都相同的情况下e值相加。
2：按AB列中值出现的总数量多的排在前面，
例：材料A，378 总数量出现17
材料A 548总数量出现14次，但有一次F值不同，要分开
希望只用一个按纽就能解决.如有做好的请发[email protected]
Hello感觉可以使用数据透视表解决
如上图，将你的数据按右上角方式制成表格，添加了辅助列“尺寸”，里面是公式=MIN(B2:C2)&"*"&MAX(B2:C2), 然后按下图添加数据透视表，当然，关掉数据分类汇总和选择布局为重复所有标签。
如有疑问 qq: 40480091
的确，用数据透视表就能做到（文件附后）
：
结果太复杂了，我想更简单一点的，用VBA，一次就搞定。
以前有个网友给我做了一次，但那次数据和这次不一样，我不会修改代码，所以………………
那么就用VBA吧：
Sub abc()
Dim r, data_str
Dim sht As Worksheet
Dim c As Range
Set sht = Worksheets("分类汇总")
sht.Cells.Clear ' 清除原有汇总数据
With ActiveSheet
.Rows(1).Copy Destination:=sht.Rows(1) ' 复制标题行
For r = 2 To 500 ' 请修改为实际的数据行数
If .Range("D" & r) <> "" Then ' 跳过空行
data_str = Range("B" & r) & Range("C" & r) & Range("D" & r) & Range("F" & r)
Set c = sht.Range("A:A").Find(data_str, LookIn:=xlValues, lookat:=xlWhole) ' 在分类汇总表中查找相同数据项
If c Is Nothing Then Set c = sht.Range("A1048576").End(xlUp).Offset(1, 0) ' 如果未找到，则定位新记录行
.Range(.Range("B" & r), .Range("D" & r)).Copy Destination:=c.Offset(0, 1) ' 复制尺寸1、尺寸2、材料到汇总表
.Range("F" & r).Copy Destination:=c.Offset(0, 5) ' 复制处理方法到汇总表
c.Offset(0, 4) = c.Offset(0, 4) + .Range("E" & r) ' 统计数量
c.FormulaR1C1 = "=RC[1]&RC[2]&RC[3]&RC[5]" ' 设置索引公式
c.Offset(0, 6).FormulaR1C1 = "=sumifs(C[-2]:c[-2], c[-4]:c[-4], rc[-4], c[-3]:c[-3], rc[-3])" ' 设置排序辅助列
End If
Next r
End With
With sht
.Range("A:G").Sort key1:=.Range("G1"), order1:=xlDescending, key2:=.Range("E1"), order2:=xlDescending, Header:=xlYes ' 排列汇总数据
.Range("A:A").Clear ' 清除辅助索引
.Activate
End With
End Sub
如果满分是100分的话，我给你98，
因为你的结果并没有完全达到我的要求，
材料B以后列表中还有材料A出现，
你可以看一下结果的最后一行。
这个小问题只要重新排下序就行了，辅助列也已经做好，应该很简单。
根据要求：第一按材料排序，其次按尺寸2出现的次数降序排列
代码已修改，请看附件。
QQ396030062
本回答被提问者采纳