求助各位大神 如何把多个相同数据 每行的不同内容 按表头 合并

1336034675

如何把多行相同数据名称里的每行的不同内容 按表头 合并在同一个单元格内。    详情请看附件  附件只有几行几列数据，实际是有很多数据的；甚至含有多个表头····

明天会更好zj

Sub tt()
Dim Dic
Dim i, j, n, m
Dim arr, brr(1 To 10000, 1 To 8)
Sheets("结果").Range("a2:h1000").ClearContents
Set Dic = CreateObject("scripting.dictionary")
arr = Sheets("数据源").Range("a1").CurrentRegion
For i = 2 To UBound(arr, 1)
    For j = 2 To UBound(arr, 2)
        If arr(i, j) <> "" Then
            If Dic.exists(arr(i, 1)) Then
                x = Dic(arr(i, 1))
                If j < UBound(arr, 2) Then
                    brr(x, j) = brr(x, j) & "、" & arr(i, j)
                Else
                    brr(x, 1) = arr(i, 1)
                    brr(x, j) = brr(x, j) + arr(i, j)
                End If
               
            Else
                n = n + 1
                Dic(arr(i, 1)) = n
                brr(n, j) = arr(i, j)
            End If
        End If
    Next
Next
Sheets("结果").Range("a2").Resize(n, 8) = brr

End Sub

shiruiqiang

字典搞一下，数据不多，没代表性，排除表头，里面“、”忘了改“；”

dambcer

pq处理                                                         

gwjkkkkk

请参考附件。。。

LIUZHU

既然楼主的办公软件是WPS，也来一点JS宏的方案

LIUZHU

请用WPS测试附件

1336034675

shiruiqiang 发表于 2022-12-29 17:50
字典搞一下，数据不多，没代表性，排除表头，里面“、”忘了改“；”

表头如果多的话 实现不了···

1336034675

LIUZHU 发表于 2022-12-30 09:24
请用WPS测试附件

我后面增加几列的话  后面没数据····   

shiruiqiang

1336034675 发表于 2022-12-30 09:35
表头如果多的话 实现不了···

没详细数据，不好说。代码已经排查第一项，其余关键字没看见不好判断。建议各种情况的发上来。其次，可以每个分表打包发上来，无需汇总，可以遍历一下文件，你也方便一点。