正则表达式+数组提取数据

Groove

我用正则表达式+数组提取数据我需要的文字符串 (提最第一个出现的组合英文+数字), 之后再出现相同组合都不要,
但数组中arr会返回一些我不需要的文字符串. 因为我需要用上数组加快数据生成, 数组方面应该怎改
求大神们教路.
---------------------------------------------------------------------
Sub regular()
Dim text, i&, reg As Object
Set reg = CreateObject("vbscript.regexp")
Range("B:B").ClearContents
arr = Worksheets("AAA").Range("A1").CurrentRegion
For i = 2 To UBound(arr)
    text = Cells(i, 1)
        With reg
            .Global = False
            .ignorecase = True
            .Pattern = " ([a-zA-z]+[0-9]+) "
                For Each Item In .Execute(text)
                    arr(i, 1) = Item.submatches(0)
                Next
            End With
Next i
Range("B1").Resize(UBound(arr)) = arr
End Sub

changhong8

自定义函数，D2=tq(B2,"\b[a-zA-Z]\w+\d\b",1)，自己测试下
Function tq(Str As Variant, Pattern As String, Optional num As Integer) As String
    Dim r As Object, mh As Object
    Set r = CreateObject("vbscript.regexp")
    With r
        .Pattern = Pattern
        .Global = True
        If .test(Str) Then
            Set mhs = .Execute(Str)
            If num = 0 Then
                For Each mh In mhs
                    tq = tq & Chr(10) & mh.Value
                Next
                tq = Right(tq, Len(tq) - 1)
            Else
                tq = mhs(num - 1)
            End If
        Else
            tq = ""
        End If
    End With
    Set r = Nothing
    Set mhs = Nothing
End Function

liulang0808

1. Sub regular()
   
2. Dim text, i&, reg As Object
   
3. Set reg = CreateObject("vbscript.regexp")
   
4. Range("B:B").ClearContents
   
5. 
   
6. arr = Worksheets("AAA").Range("A1").CurrentRegion
   
7. For i = 2 To UBound(arr)
   
8.     text = Cells(i, 1)
   
9.         With reg
   
10.             .Global = False
    
11. '            .ignorecase = True
    
12.             .Pattern = " ([a-zA-z]+[0-9]+) "
    
13.             If .test(text) Then
    
14.                 arr(i, 1) = .Execute(text)(0)
    
15.             Else
    
16.                 arr(i, 1) = ""
    
17.             End If
    
18. '                For Each Item In .Execute(text)
    
19. '                    arr(i, 1) = Item.submatches(0)
    
20. '                Next
    
21.             End With
    
22. Next i
    
23. 
    
24. Range("B1").Resize(UBound(arr)) = arr
    
25. End Sub
    

复制代码

liulang0808

详见附件，在楼主原代码上做的调整，供参考

Chip_Kenny

1. Sub zz()
   
2. Dim b()
   
3. a = [a2:a10]: ReDim b(1 To UBound(a), 1 To 1)
   
4. With CreateObject("vbscript.regexp")
   
5.     .Pattern = ".*? (\b[a-zA-Z]+\d+\b).*"
   
6.     For i = 1 To UBound(a)
   
7.         If .test(a(i, 1)) Then b(i, 1) = .Replace(a(i, 1), "$1")
   
8.     Next
   
9. End With
   
10. [d2].Resize(i - 1) = b
    
11. End Sub

复制代码

taller

1. Sub RegExpDemo()
   
2.     Dim strTxt As String
   
3.     Dim objRegEx As Object, objMatch As Object
   
4.     Dim objMH As Object, c As Range
   
5.     Set objRegEx = CreateObject("vbscript.regexp")
   
6.     objRegEx.Pattern = "\b([a-zA-Z]+\d+)\b.*"
   
7.     objRegEx.Global = True
   
8.     'objRegEx.MultiLine = True
   
9.     Set datarng = Range([a2], [a2].End(xlDown))
   
10.     datarng.Offset(0, 1).ClearContents
    
11.     For Each c In datarng
    
12.         strTxt = c.Value
    
13.         Set objMatch = objRegEx.Execute(strTxt)
    
14.         If objMatch.Count > 0 Then
    
15.             c.Offset(0, 1).Value = objMatch(0).submatches(0)
    
16.         End If
    
17.     Next
    
18.     Set objMH = Nothing
    
19.     Set objMatch = Nothing
    
20.     Set objRegEx = Nothing
    
21. End Sub

复制代码

DevilW

数据不是很复杂，Split 和 Like 可以搞定

1. Sub test()
   
2.     ar = [a2:a10]
   
3.     For i = 1 To UBound(ar)
   
4.         k = Split(ar(i, 1), " ")
   
5.         For j = 0 To UBound(k)
   
6.             If k(j) Like "[a-zA-Z]*#" Then
   
7.                 x = 1
   
8.                 GoTo tiao
   
9.             End If
   
10.         Next
    
11. tiao:
    
12.     If x = 1 Then ar(i, 1) = k(j) Else ar(i, 1) = ""
    
13.     x = ""
    
14.     Next
    
15.     [d2:d10] = ar
    
16. End Sub

复制代码

wang-way

pgp5866

=REGEXEXTRACT(A2,"[A-z]+\d+|$")

ykcbf1100

正则练习。。。