[已解决]如何分类计算多列数据？

kangkangtianxia

如何根据“数据源”中的单位进行分类，并分别计算两列“数量”的总数？想要的结果见“目标结果”。详细见附件。谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-4-17 06:24

1. Sub Macro1()
   
2. Dim rng As Range, i&
   
3. Sheet1.Activate
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. ActiveSheet.UsedRange.Clear
   
7. [c1] = "合计1": [e1] = "合计2"
   
8. With Sheets("数据源")
   
9.     .[a:b].Copy [a1]
   
10.     .[c:c].Copy [d1]
    
11. End With
    
12. Set rng = Cells(2, 1)
    
13. For i = 3 To Range("a65536").End(xlUp).Row + 1
    
14.     If Cells(i, 1) = Cells(i - 1, 1) Then
    
15.         Set rng = Union(rng, Cells(i, 1))
    
16.     Else
    
17.         Cells(i - 1, 3) = Application.Sum(rng.Offset(0, 1))
    
18.         Cells(i - 1, 5) = Application.Sum(rng.Offset(0, 3))
    
19.         rng.Offset(0, 2).Merge
    
20.         rng.Offset(0, 4).Merge
    
21.         Set rng = Cells(i, 1)
    
22.     End If
    
23. Next
    
24. Application.DisplayAlerts = True
    
25. Application.ScreenUpdating = True
    
26. End Sub

复制代码

跳转到最佳答案楼层

爱疯

如果只想求出各单位的合计，其实用数据透视表就很方便了。
非要弄成目标"目标结果"工作表中的样子？

kangkangtianxia

爱疯 发表于 2015-4-16 11:01
如果只想求出各单位的合计，其实用数据透视表就很方便了。
非要弄成目标"目标结果"工作表中的样子？ ...

首先谢谢你的回复！其实我想要的是分开的数据和合计的数据同时显示。。所以就想要“目标结果”的样式了。。可以吗？？谢谢！！

dsmch

1. Sub Macro1()
   
2. Dim rng As Range, i&
   
3. Sheet1.Activate
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. ActiveSheet.UsedRange.Clear
   
7. [c1] = "合计1": [e1] = "合计2"
   
8. With Sheets("数据源")
   
9.     .[a:b].Copy [a1]
   
10.     .[c:c].Copy [d1]
    
11. End With
    
12. Set rng = Cells(2, 1)
    
13. For i = 3 To Range("a65536").End(xlUp).Row + 1
    
14.     If Cells(i, 1) = Cells(i - 1, 1) Then
    
15.         Set rng = Union(rng, Cells(i, 1))
    
16.     Else
    
17.         Cells(i - 1, 3) = Application.Sum(rng.Offset(0, 1))
    
18.         Cells(i - 1, 5) = Application.Sum(rng.Offset(0, 3))
    
19.         rng.Offset(0, 2).Merge
    
20.         rng.Offset(0, 4).Merge
    
21.         Set rng = Cells(i, 1)
    
22.     End If
    
23. Next
    
24. Application.DisplayAlerts = True
    
25. Application.ScreenUpdating = True
    
26. End Sub

复制代码

kangkangtianxia

dsmch 发表于 2015-4-17 06:24

谢谢！是我主要的结果了。。