EXCEL如何合并A列重复项的同时将B列数据叠加？

Question

需要将一张有数万条记录的EXCEL表中A列的重复数据去重，而B列的数据不能丢失，实现如下图所示的效果：
原始数据

整理后的效果

Answer 1

用宏吧

sub a()
    dim dic as object
    arr=activesheet.[a1].currentregion
    set dic=createobject("scripting.dictionary")
    for i=1 to ubound(arr,1)'默认没有表头,有表头的话，这里改为i=2
        dic(arr(i,1))=dic(arr(i,1)) & " " & arr(i,2)
    next
    for each ke in dic
        dic(ke)=mid(dic(ke),2)
    next
    '结果放DE列
    activesheet.[d1].resize(dic.count,1)=application.transpose(dic.keys)
    activesheet.[e1].resize(dic.count,1)=application.transpose(dic.items)
end sub

 刚才有错，改一下！！！

追问

你好，试用了你提供的代码，A列去重的要求实现了，但B列叠加的要求没能实现。执行效果如图：

请指教。

追答

你的新数据需要放哪里？

我刚才漏了第二列，代码已经改过了，估计百度没提示

sub a()
    dim dic as object
    arr=activesheet.[a1].currentregion
    set dic=createobject("scripting.dictionary")
    for i=1 to ubound(arr,1)'默认没有表头,有表头的话，这里改为i=2
        dic(arr(i,1))=dic(arr(i,1)) & " " & arr(i,2)'这里我刚才改过了
    next
    for each ke in dic
        dic(ke)=mid(dic(ke),2)
    next
    '结果放DE列
    activesheet.[d1].resize(dic.count,1)=application.transpose(dic.keys)
    activesheet.[e1].resize(dic.count,1)=application.transpose(dic.items)
end sub

追问

你好，执行时报错

追答

哪行报错？

我这里是正常的。

Answer 2

请问，使用VBA代码完成可以吗？追问

可以的，请问代码要怎么写呢？

追答

需要先将E列单元格格式设置为文本

Sub Macro1()
    Dim iRow As Long, i As Long
    Dim dRow As Long, j As Long
    iRow = Range("A60000").End(xlUp).Row
    Range("A1:A" & iRow).AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=Range("D1"), Unique:=True
    dRow = Range("D60000").End(xlUp).Row
    For j = 2 To dRow
        For i = 2 To iRow
            If Cells(i, 1).Text = Cells(j, 4).Text Then
                Cells(j, 5) = Cells(j, 5) & Cells(i, 2) & " "
            End If
        Next i
    Next j
End Sub

本回答被提问者采纳