求助多个单元格数据合并

水流声

各位大神

  新年好

  小弟在工作中遇到一个问题，多个单元格数据合并到一格单元格里， 具体详见附图，   数据实在太多，   请各位大神出手相助！

谢谢！


跪求各位大神，    谢谢了！！！

水流声

各位大神  在线求等！！！

水流声

拜托各位大神了！！！   跪求了！！！急！！

dsmch

1. Sub dsmch()
   
2. Dim arr, brr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 2)
   
6. For i = 2 To UBound(arr)
   
7.     If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
   
8.     If Not d.exists(arr(i, 1)) Then
   
9.         d(arr(i, 1)) = i
   
10.         brr(i, 1) = arr(i, 2)
    
11.         brr(i, 2) = arr(i, 3)
    
12.     Else
    
13.         n = d(arr(i, 1))
    
14.         brr(n, 1) = brr(n, 1) & "/" & arr(i, 2)
    
15.         brr(n, 2) = brr(n, 2) & "/" & arr(i, 3)
    
16.     End If
    
17. Next
    
18. Range("g1").Resize(UBound(brr), 2) = brr
    
19. End Sub

复制代码

wj2368

。。。。。。。。。。。

水流声

dsmch 发表于 2019-1-21 10:19

谢谢！大神， 完美！！

祝大神全家身体健康，万事如意， 新年快乐！！


再次感谢！