重复数据合并计算问题

aichimalayu

各位前辈好
发现自己在excel的vba编写中特别不擅长循环
这么个问题都处理不好，还请帮忙，谢谢
原始数据：

产品名称	计划
	吨
1	1
2	2
3	3
4	5
5	6
6	7
1	8
2	9
3	10

问题：
将产品名称列相同的合并，并将右侧计划合计后显示，在源数据处操作即可

目标效果：

产品名称	计划
	吨
1	9
2	11
3	13
4	5
5	6
6	7

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet1")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a3:b" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
    
11.     Next
    
12.     .Range("g5").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    
13.   End With
    
14. End Sub
    

复制代码

chxw68

字典的基本应用。

aichimalayu

chxw68 发表于 2017-1-23 09:33
字典的基本应用。

哎呀老师太感谢了
数组我还不会用，学习了

aichimalayu

chxw68 发表于 2017-1-23 09:33
字典的基本应用。

前辈，代码很好用，但和实际应用有个小的问题还想请教下
产品名称中，有部分0开头的，能够保留住这个0吗？
采用文本格式未能在数组操作后保留住前面的0
还请指教

zard2004

设置G列为文本格式就好了

1. ...
   
2.     .Columns("G:G").NumberFormatLocal = "@"  '设置G列为文本格式
   
3.     .Range("g5").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
   

复制代码

aichimalayu

zard2004 发表于 2017-1-23 13:58
设置G列为文本格式就好了

哦！原来不是要设置源数据格式，而是要设置目标位置格式，谢谢！

lsc900707

Sub lsc()
    Dim d, arr, i, j
    Set d = CreateObject("scripting.dictionary")
    i = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A3:B" & i)
    For j = 1 To UBound(arr)
        d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)
    Next
    [g3:h50000] = ""
    Columns(7).NumberFormatLocal = "@"  
    [g3].Resize(d.Count) = Application.Transpose(d.keys)
    [h3].Resize(d.Count) = Application.Transpose(d.items)
End Sub