合并与拆分

jaxxcyh

Sub 分分合合()
    Dim arr, brr, brrTmp
    Dim myrow%, myrowB%, mycolB%
    myrowA = Range("A" & Rows.Count).End(xlUp).Row
    myrowB = Range("B" & Rows.Count).End(xlUp).Row
    If myrowA > myrowB Then myrow = myrowA Else myrow = myrowB
   
    arr = Range("A1:A" & myrowA).Value
    For i = 2 To myrow
        If Range("A" & i) <> "" And _
           Range("B" & i) = "" Then         '如果A有B无
            brr = Split(arr(i, 1), ",")
            Range("B" & i). _
                Resize(1, UBound(brr) + 1).Value = brr
        End If
        
        If Range("A" & i) = "" And _
           Range("B" & i) <> "" Then        '如果A无B有
            mycolB = Range("B" & i).End(xlToRight).Column - 1
            brr = Range("B" & i).Resize(1, mycolB).Value
            brrTmp = Application.Transpose(Application.Transpose(brr))  '二维转一维
            Range("A" & i).Value = Join(brrTmp, ",")
        End If
    Next
End Sub

jaxxcyh

审核机制太拖拉了，发上去半天没看到，以为发失败了，又重发，结果就是这样发了好几遍。抱歉。

jx928867128

jaxxcyh 发表于 2024-8-18 10:51
审核机制太拖拉了，发上去半天没看到，以为发失败了，又重发，结果就是这样发了好几遍。抱歉。

再次谢谢各位老师的关注与帮忙，刚刚发现那个拆分原来可以直接用EXCEL的数据拆分功能处理

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.8.18  拆分
   
2.     With Sheets("Sheet1")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         arr = .[a1].Resize(r, 1)
   
5.         .[b2].Resize(r, 100) = ""
   
6.         For i = 2 To UBound(arr)
   
7.             st = Split(arr(i, 1), ",")
   
8.             n = 1
   
9.             For x = 0 To UBound(st)
   
10.                 n = n + 1
    
11.                 .Cells(i, n) = st(x)
    
12.             Next
    
13.         Next
    
14.     End With
    
15. End Sub
    
16. 
    
17. Sub ykcbf2()  '//2024.8.18  合并
    
18.     With Sheets("Sheet1")
    
19.         r = .Cells(Rows.Count, 2).End(3).Row
    
20.         arr = .[a1].Resize(r, 100)
    
21.         For i = 2 To UBound(arr)
    
22.             st = ""
    
23.             For j = 2 To UBound(arr, 2)
    
24.                 If arr(i, j) <> Empty Then
    
25.                     st = st & "," & arr(i, j)
    
26.                 End If
    
27.             Next
    
28.             .Cells(i, 1) = Mid(st, 2)
    
29.         Next
    
30.     End With
    
31. End Sub
    

复制代码

悠扬的旋律

lg747699

B2单元格输入，=REGEXP(A2,"[一-龟]+")，之后下拉。快吧

lg747699

quqiyuan 发表于 2024-8-18 08:44
这个用textsplit、textjoint方便咯
=TEXTSPLIT(A2,",")

万一中间是这个符；、，那就要多次了。