数据汇总并且将汇总字段的几个单元格内容合并到一个单元格

zj01234

如题，求助大神！

zj01234

附件里面的内容如截图：

abc123281

可以实现    但要用vba

abc123281

建议楼主到vba板块求助会有结果

kkf5560

我的想法是辅助列先查询出符合两个条件的所有 COLOR.LIST数据，再用 PHONETIC合并

zj01234

kkf5560 发表于 2018-3-13 16:48
我的想法是辅助列先查询出符合两个条件的所有 COLOR.LIST数据，再用 PHONETIC合并

谢谢你！
我又附了一个图片，是否可以在数据透视表里添加公式？

zj01234

abc123281 发表于 2018-3-13 16:39
建议楼主到vba板块求助会有结果

谢谢你~等我再看看没结果就投别的区吧，实在不会VBA

abc123281

呵呵  那你自己弄弄吧

abc123281

闲着也没事   帮你写写玩玩
仅供参考

1. Sub test()
   
2. Dim arr, brr(1 To 1000, 1 To 5)
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Application.DisplayAlerts = False
   
5. With Worksheets("原数据表")
   
6.   rw = .[a65536].End(xlUp).Row
   
7.   arr = .Range("a4:e" & rw)
   
8.   For i = 1 To UBound(arr)
   
9.      mx = arr(i, 1) & "*" & arr(i, 3)
   
10.      If Not d.exists(mx) Then
    
11.         n = n + 1
    
12.         d(mx) = n
    
13.         For j = 1 To 5
    
14.           brr(n, j) = arr(i, j)
    
15.         Next
    
16.      Else
    
17.         m = d(mx)
    
18.         brr(m, 2) = brr(m, 2) + arr(i, 2)
    
19.         brr(m, 4) = brr(m, 4) + arr(i, 4)
    
20.         brr(m, 5) = brr(m, 5) & "  " & arr(i, 5)
    
21.      End If
    
22.   Next
    
23.   .[h17].Resize(UBound(brr), 5) = brr
    
24.   For i = 17 To .[h65536].End(3).Row
    
25.     For x = i + 1 To .[h65536].End(3).Row
    
26.       If .Cells(x, 8) = .Cells(i, 8) Then
    
27.          .Range(.Cells(i, 8), .Cells(x, 8)).Merge
    
28.       End If
    
29.     Next
    
30.   Next
    
31. End With
    
32. Application.DisplayAlerts = True
    
33. MsgBox "OK"
    
34. End Sub

复制代码

abc123281

参考附件




数据汇总并且合并多个单元格内容abc123.rar (21.6 KB, 下载次数: 77)

2018-3-13 22:59 上传

点击文件名下载附件