VBA利用字典对多行数据进行处理

阔步炼狱

在表中A\B\C\D列相同的情况下求和G列，并汇总保留E\F\H\I列唯一值到对应单元格中，源数据是导出数据，处理后结果是想要达到的效果，有没有大神利用VBA帮忙解决一下，生成的结果表最好是到新表或其他指定表中

阔步炼狱

A\B\C\D列是去重汇总统计

jiangxiaoyun

Sub cd()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = [a1].CurrentRegion
    For i = 2 To UBound(ar)
        If Not d.exists(ar(i, 1)) Then
            d(ar(i, 1)) = ar(i, 2)
        Else
            If InStr(d(ar(i, 1)), ar(i, 2)) = 0 Then
                d(ar(i, 1)) = d(ar(i, 1)) & "，" & ar(i, 2)
            End If
        End If
    Next
   [d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End Sub


参考

3190496160

Sub test()
Set d = CreateObject("scripting.dictionary")
ar = Sheets("原数据表").[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" And Trim(ar(i, 3)) <> "" And Trim(ar(i, 4)) <> "" Then
        s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2)) & "|" & Trim(ar(i, 3)) & "|" & Trim(ar(i, 4))
        t = d(s)
        If t = "" Then
            k = k + 1
            d(s) = k
            t = k
            For j = 1 To 6
                br(k, j) = ar(i, j)
            Next j
            br(k, 8) = ar(i, 8)
        End If
        br(t, 7) = br(t, 7) + ar(i, 7)
        If Trim(ar(i, 9)) <> "" Then
            If br(t, 9) = "" Then
                br(t, 9) = ar(i, 9)
            Else
                br(t, 9) = br(t, 9) & "," & ar(i, 9)
            End If
        End If
    End If
Next i
With Sheets("处理后结果")
    .[a1].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(k, UBound(br, 2)) = br
End With

End Sub

3190496160

结果表第九列是否符合你的需求，不确定，自己测试看看