多行数据，其中某列内容进行合并

天使也花心

数据表.zip (44.99 KB, 下载次数: 12)

2022-6-23 20:58 上传

点击文件名下载附件

数据表中多行数据，部分行J列前内容相同，要实现通过公式或VBA程序生成另一张表，表内J列前相同行合并，J列内容为合并后数据。详见附件。
感谢各位解惑

合并后

zpy2

select 姓名,证件类型,证件号码,开户行,卡号,地址,手机号码,品种,group_concat(品名||数量||单位,'、') 品名,数量,单位 from 基础多列分组合并之合并品名数量 group by 姓名,证件类型,证件号码,开户行,卡号,地址,手机号码,品种 order by 序号;

liulang0808

Sub test()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("数据表").UsedRange
    r = 3
    For j = 4 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then
            str1 = ""
            For i = 2 To 9
                str1 = str1 & "#" & arr(j, i)
            Next i
            If Not d.exists(str1) Then
                r = r + 1
                d(str1) = r
                For i = 2 To UBound(arr, 2)
                    arr(r, i) = arr(j, i)
                Next i
                arr(r, 1) = r - 3
                arr(r, 10) = arr(r, 10) & arr(r, 11) & "斤"
            Else
                x = d(str1)
                arr(x, 10) = arr(x, 10) & "、" & arr(j, 10) & arr(j, 11) & "斤"
                arr(x, 11) = arr(x, 11) + arr(j, 11)
            End If
        End If
    Next j
    Sheets("结果").[a1].Resize(r, UBound(arr, 2)) = arr
End Sub

liulang0808

附件内容供参考。。。。。。

天使也花心

zpy2 发表于 2022-6-23 22:10
select 姓名,证件类型,证件号码,开户行,卡号,地址,手机号码,品种,group_concat(品名||数量||单位,'、') 品 ...

感谢，测试下

天使也花心

liulang0808 发表于 2022-6-23 22:22
附件内容供参考。。。。。。

感谢版主，非常好用

天使也花心

liulang0808 发表于 2022-6-23 22:22
附件内容供参考。。。。。。

您好版主，麻烦看下，相同品名应全部合并

tel3033

供参考……

liulang0808

Sub test()
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("数据表").UsedRange
    r = 3
    For j = 4 To UBound(arr)
        If Len(arr(j, 2)) > 0 Then
            str1 = ""
            For i = 2 To 9
                str1 = str1 & "#" & arr(j, i)
            Next i
            If Not d.exists(str1) Then
                r = r + 1
                For i = 2 To UBound(arr, 2)
                    arr(r, i) = arr(j, i)
                Next i
                arr(r, 1) = r - 3
                Set d(str1) = CreateObject("scripting.dictionary")
            End If
            d(str1)(arr(j, 10)) = d(str1)(arr(j, 10)) + arr(j, 11)
        End If
    Next j
    For j = 4 To r
        str1 = ""
        For i = 2 To 9
            str1 = str1 & "#" & arr(j, i)
        Next i
        str2 = ""
        sm = 0
        For Each x In d(str1).keys
            str2 = str2 & "," & x & d(str1)(x) & "斤"
            sm = sm + d(str1)(x)
        Next x
        arr(j, 10) = Mid(str2, 2)
        arr(j, 11) = sm
    Next j
    Sheets("结果").[a1].Resize(r, UBound(arr, 2)) = arr
End Sub

liulang0808

附件内容供参考。。。。。。