单元格字符提取

wtzxuexivba

liulang0808

Sub 按钮1_Click()
    r = Cells(Rows.Count, 1).End(3).Row
    arr = [a1].Resize(r)
    With CreateObject("vbscript.regexp")
        .Pattern = "[A-z]+"
        For J = 1 To UBound(arr)
            If .test(arr(J, 1)) Then
                arr(J, 1) = .Execute(arr(J, 1))(0)
            Else
                arr(J, 1) = ""
            End If
        Next J
    End With
    [c1].Resize(r) = arr
End Sub

liulang0808

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

wtzxuexivba

感谢大神用正则表达式的方法帮我解决问题。不知还有那位大神有其他思路，让我们一起探讨学习。

ykcbf1100

正则提取。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.21
   
2.     Set reg = CreateObject("VBScript.Regexp")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 1)
   
5.     With reg
   
6.         .Pattern = "\d+.*$"
   
7.         For i = 1 To UBound(arr)
   
8.             s = Cells(i, 1).Value
   
9.             Cells(i, 2).Value = .Replace(s, "")
   
10.         Next
    
11.     End With
    
12. End Sub
    
13. 
    

复制代码

wtzxuexivba

请问大神:如何理解这句代码？

If .test(arr(J, 1)) Then

ykcbf1100

wtzxuexivba 发表于 2024-8-21 20:33
请问大神:如何理解这句代码？

If .test(arr(J, 1)) Then

如果有符合正则表达式的，则

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, isFlag As Boolean, i&, j&, vTemp, r&, n&
   
    r = Cells(Rows.Count, "A").End(xlUp).Row
    ar = Range("A1:A" & r).Value
    For i = 1 To UBound(ar)
        isFlag = True
        For j = 1 To Len(ar(i, 1))
            vTemp = Mid(ar(i, 1), j, 1)
            If IsNumeric(vTemp) Then
                n = j - 1: isFlag = False
                Exit For
            End If
        Next j
        If isFlag = False Then ar(i, 1) = Left(ar(i, 1), n)
    Next i

    [C1].Resize(UBound(ar)) = ar
    Beep
End Sub

gwjkkkkk

数组法，请参考。。。