多行汇总求和某列合并不重复项

转角处的沉思

请教如何实现图示效果1.如存在行数据对应的A,D列组合数据重复且G列对应的值相同则对行数据去重同时F列累加；2.如存在行数据对应的A,D列组合数据重复且G列对应的值不同则对行数据去重同时G列合并。补充去重规则说明：首先针对A,D,G三列均相同的情况采取去重的同时F列求和，然后对A,D,F三列均相同的情况再执行仅去重（保留唯一行）的同时合并G列内容。（逻辑上先求和再合并，如能一起实现也可）

shiruiqiang

把相关列1和相关列4作为字典

quqiyuan

参与一下，字典。。。

quqiyuan

代码如下
Sub test()
arr = Sheet1.[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
n = 1
Dim brr(1 To 10000, 1 To 7)
For i = 2 To UBound(arr)
    s = arr(i, 1) & arr(i, 4)
    If Not d.exists(s) Then n = n + 1: d(s) = n
    m = d(s)
    brr(m, 1) = arr(i, 1)
    brr(m, 2) = arr(i, 2)
    brr(m, 3) = arr(i, 3)
    brr(m, 4) = arr(i, 4)
    brr(m, 5) = arr(i, 5)
    brr(m, 6) = brr(m, 6) + arr(i, 6)
    If brr(m, 7) = Empty Then brr(m, 7) = arr(i, 7) Else If _
        InStr(brr(m, 7), arr(i, 7)) = 0 Then brr(m, 7) = brr(m, 7) & "," & arr(i, 7)
Next
With Sheet2
    .[j1].CurrentRegion.Clear
        With .[j1].Resize(n, 7)
            .Value = brr
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = 1
        End With
        .[j1].Resize(, 7) = arr
        .[j1].Resize(, 7).Font.Bold = True
        .[j1].Resize(n, 7).Columns.AutoFit
End With
Set d = Nothing
Beep
End Sub

liulang0808

如果ADFG四列出现这样的布局，结果是什么？

wang-way

以 AD 为key，F计数  G列串接为值

wang-way

转角处的沉思

quqiyuan 发表于 2024-6-22 07:46
参与一下，字典。。。

感谢帮助，F列累加的时候应该多个判断，就是如果A,D,G列值都相同时需要累加，而A,D相同仅G不同说明重复，此时只去重不累加但要对G列合并.

转角处的沉思

liulang0808 发表于 2024-6-22 08:03
如果ADFG四列出现这样的布局，结果是什么？

刘版仔细，这种特殊情况本次不会出现，实际上只当最后一列不同且第一列相同的情况下，说明不同的G列值对应的行属于同一种类型，只需对G列字符合并。而只有当A,G列都相同的情况下需要对F列做求和处理。

转角处的沉思

liulang0808 发表于 2024-6-22 08:03
如果ADFG四列出现这样的布局，结果是什么？

版主所描述的情况如果出现，只会出现如图这样的情况，这种情况下，想当于是要先局部F列求和，然后再对不同的G列合并字符串了。