提取的数字文字错乱

朱付安

问题在附件中，提取的太乱了，请问老师怎么修改

ykcbf1100

附件供参考。。。

liulang0808

Sub test()
    r = Cells(Rows.Count, 1).End(3).Row
    arr = [a1].Resize(r, 3)
    With CreateObject("vbscript.regexp")
        .Pattern = "-?\d+(\.\d+)?"
        For j = 1 To UBound(arr)
            If .test(arr(j, 1)) Then
                str1 = .Execute(arr(j, 1))(0)
                arr(j, 2) = Split(arr(j, 1), str1)(0)
                arr(j, 3) = str1
            Else
                arr(j, 2) = ""
                arr(j, 3) = ""
            End If
        Next j
    End With
    [o1].Resize(r, 3) = arr
End Sub

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.3.28
   
2.     Dim reg, mh
   
3.     Set reg = CreateObject("vbscript.regexp")
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, "a").End(xlUp).Row
   
6.         arr = .[a1].Resize(r, 3)
   
7.         With reg
   
8.             .Global = True
   
9.             .Pattern = "[+-]?\d+(\.\d+)?|\.\d+ "
   
10.             For i = 1 To UBound(arr)
    
11.                 Set mh = .Execute(arr(i, 1))
    
12.                 arr(i, 3) = mh(0).Value
    
13.                 arr(i, 2) = Replace(arr(i, 1), arr(i, 3), "")
    
14.             Next
    
15.         End With
    
16.         .[a1].Resize(r, 3) = arr
    
17.     End With
    
18. End Sub
    

复制代码

liulang0808

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

朱付安

liulang0808 发表于 2024-3-28 07:59
附件内容供参考。。。。。

谢谢老师，我测试一下

swl4561255

B1数组公式：

1. =LEFT(A1,MATCH(1=1,MID(A1,ROW($1:$9),1)<"A",)-1)

复制代码

C1数组公式：

1. =MID(A1,MATCH(1=1,MID(A1,ROW($1:$9),1)<"A",),9)

复制代码