[已解决]功能要求：使用VBA实现产品种类分类汇总对应的金额

东来之峰

功能要求：使用VBA实现产品种类分类汇总对应的金额，请教大家怎么实现，先谢谢了

最佳答案

月排行榜 / 总排行榜

冥王

2015-5-21 17:32

1. Sub demo()
   
2.     Dim dic As Object, i%, arr
   
3.     Set dic = CreateObject("Scripting.Dictionary")
   
4.     With ThisWorkbook.Sheets("数据库")
   
5.         arr = .Range("A4:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
6.         For i = LBound(arr) To UBound(arr)
   
7.             dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 2)
   
8.         Next
   
9.         Sheets("汇总表").Range("B4").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
   
10.     End With
    
11.     Set dic = Nothing
    
12. End Sub
    

复制代码

跳转到最佳答案楼层

爱疯

建议
1）用数据透视表不是更方便吗？
2）上传excel文件

东来之峰

Sub huizong()
Dim fin1 As Range, fin2 As Range, str1 As String, str2 As String
For Each fin1 In Selection
For Each fin2 In Range("e4:e" & [b65536].End(xlUp).Row)
If fin1.Text = fin2.Text Then fin1.Offset(0, 1) = fin1.Offset(0, 1) + fin2.Offset(0, 1)
Next
Next
End Sub

东来之峰

爱疯 发表于 2015-5-21 17:15
建议
1）用数据透视表不是更方便吗？
2）上传excel文件

1. Sub huizong()
   
2. Dim fin1 As Range, fin2 As Range, str1 As String, str2 As String
   
3. For Each fin1 In Selection
   
4. For Each fin2 In Range("e4:e" & [b65536].End(xlUp).Row)
   
5. If fin1.Text = fin2.Text Then fin1.Offset(0, 1) = fin1.Offset(0, 1) + fin2.Offset(0, 1)
   
6. Next
   
7. Next
   
8. End

复制代码

爱疯

东来之峰 发表于 2015-5-21 17:20

最主要是要有图片中的excel文件，才方便别人来回复你的问题。

只要准备做好了，自然会有朋友来帮忙的。

东来之峰

爱疯 发表于 2015-5-21 17:15
建议
1）用数据透视表不是更方便吗？
2）上传excel文件

我想实现不在同一个sheet表的汇总，把相似项目对应的数值统计到另外一个sheet表内，操作步骤是：先在表格内输入要汇总的项目名称，然后选中输入的项目，然后运行VBA，目标数据源内的对应的相同项目的数值自动统计到汇总表内

东来之峰

爱疯 发表于 2015-5-21 17:23
最主要是要有图片中的excel文件，才方便别人来回复你的问题。

只要准备做好了，自然会有朋友来帮忙的。 ...

这是表格，请您帮我看看，谢谢了

冥王

1. Sub demo()
   
2.     Dim dic As Object, i%, arr
   
3.     Set dic = CreateObject("Scripting.Dictionary")
   
4.     With ThisWorkbook.Sheets("数据库")
   
5.         arr = .Range("A4:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
6.         For i = LBound(arr) To UBound(arr)
   
7.             dic(arr(i, 1)) = dic(arr(i, 1)) + arr(i, 2)
   
8.         Next
   
9.         Sheets("汇总表").Range("B4").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
   
10.     End With
    
11.     Set dic = Nothing
    
12. End Sub
    

复制代码

东来之峰

冥王 发表于 2015-5-21 17:32

您太厉害了，谢谢了