[已解决]怎样用VBA分类汇总？

小雨饰品

求用VBA进行分类汇总的方法，效果如附件，谢谢

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2015-8-17 14:53

1. Sub gd()
   
2. Dim arr, adS$
   
3. Sheets("2015").Copy after:=Sheets(Sheets.Count)
   
4. arr = ActiveSheet.UsedRange
   
5. For a = UBound(arr) To 4 Step -1
   
6.      If arr(a, 16) <> "" Then
   
7.           tmp = arr(a, 16)
   
8.           t = a - 1
   
9.           Do Until arr(t, 16) <> tmp
   
10.                t = t - 1: If t < 4 Then Exit Do
    
11.           Loop
    
12.           Rows(a + 1).Insert: Cells(a + 1, "p") = tmp & " 汇总"
    
13.           Cells(a + 1, "f").Resize(1, 10).Formula = "=sum(f" & a & ":f" & t + 1 & ")"
    
14.           a = t + 1
    
15.      End If
    
16. Next
    
17. arr = ActiveSheet.UsedRange
    
18. For a = 4 To UBound(arr)
    
19.      If InStr(arr(a, 16), "汇总") Then: adS = adS & "f" & a & ","
    
20. Next
    
21. Cells(UBound(arr), "f").Resize(1, 10).Formula = "=sum(" & adS & ")"
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

gufengaoyue

1. Sub gd()
   
2. Dim arr, adS$
   
3. Sheets("2015").Copy after:=Sheets(Sheets.Count)
   
4. arr = ActiveSheet.UsedRange
   
5. For a = UBound(arr) To 4 Step -1
   
6.      If arr(a, 16) <> "" Then
   
7.           tmp = arr(a, 16)
   
8.           t = a - 1
   
9.           Do Until arr(t, 16) <> tmp
   
10.                t = t - 1: If t < 4 Then Exit Do
    
11.           Loop
    
12.           Rows(a + 1).Insert: Cells(a + 1, "p") = tmp & " 汇总"
    
13.           Cells(a + 1, "f").Resize(1, 10).Formula = "=sum(f" & a & ":f" & t + 1 & ")"
    
14.           a = t + 1
    
15.      End If
    
16. Next
    
17. arr = ActiveSheet.UsedRange
    
18. For a = 4 To UBound(arr)
    
19.      If InStr(arr(a, 16), "汇总") Then: adS = adS & "f" & a & ","
    
20. Next
    
21. Cells(UBound(arr), "f").Resize(1, 10).Formula = "=sum(" & adS & ")"
    
22. End Sub
    

复制代码

小雨饰品

gufengaoyue 发表于 2015-8-17 14:53

谢谢啦。这正是我想要的效果

bel_joe

谢谢，非常好！