分拆

ddz79101

老师！有列其中单元格有3部分构成，希望将单元格分为3列。请老师帮忙看看。谢谢

liulang0808

Sub 按钮1_Click()
    r = Cells(Rows.Count, 4).End(3).Row
    arr = [d2].Resize(r - 1, 3)
    With CreateObject("vbscript.regexp")
        .Pattern = "([一-龥]+)\s(.+?)(\d+.*)$"
        .Global = True
        For j = 1 To UBound(arr)
            str1 = arr(j, 1)
            If .test(str1) Then
                Set mh = .Execute(str1)
                arr(j, 1) = mh(0).submatches(0)
                arr(j, 2) = mh(0).submatches(1)
                arr(j, 3) = "'" & mh(0).submatches(2)
            End If
        Next j
    End With
    [s2].Resize(UBound(arr), 3) = arr
End Sub

liulang0808

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

^星^

分拆.zip (28.77 KB, 下载次数: 6)

2024-3-28 14:46 上传

点击文件名下载附件

ykcbf1100

用正则拆分。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.28
   
2.     Set reg = CreateObject("VBScript.Regexp")
   
3.     With Worksheets("4")
   
4.         r = .Cells(Rows.Count, 4).End(3).Row
   
5.         arr = .[d1].Resize(r, 2)
   
6.         ReDim brr(1 To UBound(arr), 1 To 4)
   
7.         With reg
   
8.             .Global = True
   
9.             .Pattern = "[一-龢]+"
   
10.             For i = 2 To UBound(arr)
    
11.                 b = Split(arr(i, 1))
    
12.                 m = m + 1
    
13.                 s = b(1)
    
14.                 Set mh = .Execute(s)
    
15.                 brr(m, 1) = b(0)
    
16.                 brr(m, 2) = mh(0).Value
    
17.                 brr(m, 3) = .Replace(s, "")
    
18.                 brr(m, 4) = arr(i, 2)
    
19.             Next
    
20.         End With
    
21.         .Columns("M:N").NumberFormatLocal = "@"
    
22.         .Range("k12").Resize(UBound(brr), UBound(brr, 2)) = brr
    
23.     End With
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

ddz79101

liulang0808 发表于 2024-3-28 14:42
Sub 按钮1_Click()
    r = Cells(Rows.Count, 4).End(3).Row
    arr = [d2].Resize(r - 1, 3)

谢谢老师！成功

ddz79101

ykcbf1100 发表于 2024-3-28 14:48
用正则拆分。。。

谢谢老师！成功分离

ddz79101

^星^ 发表于 2024-3-28 14:46

谢谢老师！正确

swl4561255

公式法，详见附件。