请教如何 用VBA查找相同的名称，相加其数量

Chiyuen

如何用VBA实现查找B列中同名的物品，数量相加，比如B1和B2同名，则数量相加为=8，，

结果放到当前表格范围向下偏移2行的位置，即从15行开始放整理后的结果，依次往下
物品的名称，每张表都不一样，所以不能预先指定，希望能够自动筛选出来

shenjianrong163

Sub test()
    Dim r%, i%
    Dim d, name, num
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("700")       '700是工作表的名称
        r = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = 2 To r
            d(Trim(.Cells(i, 2))) = d(Trim(.Cells(i, 2))) + .Cells(i, 10)
        Next
        name = d.Keys
        num = d.Items
        .Cells(r + 3, 2).Resize(d.Count, 1) = Application.Transpose(name)
        .Cells(r + 3, 10).Resize(d.Count, 1) = Application.Transpose(num)
    End With
    Set d = Nothing
End Sub

查找同名的数据，并相加.rar (15.14 KB, 下载次数: 41)

2020-1-29 00:43 上传

点击文件名下载附件
查找同名的数据，并相加

microyip

字典记录名字相加数量即可

Chiyuen

shenjianrong163 发表于 2020-1-29 00:43
Sub test()
    Dim r%, i%
    Dim d, name, num

执行成功，，非常感谢，如果想在合并计算后，删除本页计算前的数据源怎么操作？

3190496160

Chiyuen 发表于 2020-1-29 08:57
执行成功，，非常感谢，如果想在合并计算后，删除本页计算前的数据源怎么操作？

Sub test()
    Dim r%, i%
    Dim d, name, num
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("700")
        r = .Cells(.Rows.Count, 2).End(xlUp).Row
        ar = .Range("a1:j" & r)
        For i = 2 To UBound(ar)
            d(Trim(ar(i, 2))) = d(Trim(ar(i, 2))) + ar(i, 10)
        Next
        name = d.Keys
        num = d.Items
         .Range("a1:j" & r) = Empty '''清除数据源
        .Cells(r + 3, 2).Resize(d.Count, 1) = Application.Transpose(name)
        .Cells(r + 3, 10).Resize(d.Count, 1) = Application.Transpose(num)
    End With
    Set d = Nothing
End Sub

Chiyuen

3190496160 发表于 2020-1-29 09:24
Sub test()
    Dim r%, i%
    Dim d, name, num

试了一下，达到了目的。应该是清空了之前行的数据，这样的话，结果仍然在页面的下部，能不能改成删除行，

3190496160

Chiyuen 发表于 2020-1-29 09:30
试了一下，达到了目的。应该是清空了之前行的数据，这样的话，结果仍然在页面的下部，能不能改成删除行，

Sub test()
    Dim r%, i%
    Dim d, name, num
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("700")
        r = .Cells(.Rows.Count, 2).End(xlUp).Row
        ar = .Range("a1:j" & r)
        For i = 2 To UBound(ar)
            d(Trim(ar(i, 2))) = d(Trim(ar(i, 2))) + ar(i, 10)
        Next
        name = d.Keys
        num = d.Items
         .Range("a1:j" & r) = Empty '''清除数据源
        .Cells(2, 2).Resize(d.Count, 1) = Application.Transpose(name)
        .Cells(2, 10).Resize(d.Count, 1) = Application.Transpose(num)
    End With
    Set d = Nothing
End Sub

3190496160

简单的东西要学会自己动脑子，不要总是想着让别人帮你搞定，这样，你永远是个小白

excel海

这个是字典的基本用法吧

Chiyuen

3190496160 发表于 2020-1-29 09:47
简单的东西要学会自己动脑子，不要总是想着让别人帮你搞定，这样，你永远是个小白

谢谢你，正在努力学习当中，，一时没看明白 ，原来数据存储了一下的。