VBA geting other results form RegExp

[IFTODE]

Hello,

i got this code form here :https://stackoverflow.com/questions...ion-using-vba-macro-in-word/25102373#25102373

i am trying to make it write the second or third result stored in matchcollection, but i am stucked. When i use Msgbox i see all the resultates, but i can't write in excell cells

Public Function TestRegExp(myString As String, NrCrt As Long)
'Create objects.
Dim objRegExp As RegExp
Dim colMatches As MatchCollection, objMatch As Match
Dim RetStr As String, valori(0 To 100) As String
Dim i As Long, f As Long


Set objRegExp = New RegExp ' Create a regular expression object.


objRegExp.Pattern = "([a-z]{3}\d{5})\W" 'Set the pattern by using the Pattern property.
objRegExp.IgnoreCase = True 'Set Case Insensitivity.
objRegExp.Global = True 'Set global applicability.


If (objRegExp.Test(myString) = True) Then 'Test whether the String can be compared.


'Get the matches.
Set colMatches = objRegExp.Execute(myString) ' Execute search.




For Each objMatch In colMatches ' Iterate Matches collection.
i = 0
valori(i + 1) = objMatch.SubMatches(i)
' MsgBox objMatch.SubMatches(0)
i = i + 1
Next objMatch




Set objMatch = Nothing
Set colMatches = Nothing
Set objRegExp = Nothing
End If
TestRegExp= valori(NrCrt)
End Function

Thx for help

 

[Domenic]

Try using brackets to define your capture groups for your regular expression. So, let's say that you want to capture the 3 letters and you want to capture the 5 digits...

objRegExp.Pattern = "([a-z]{3})(\d{5})\W"

Then objMatch will return the 3 letters and 5 digits, objMatch.SubMatches(0) will return the 3 letters, and objMatch.SubMatches(1) will return the 5 digits.

Hope this helps!

 

[IFTODE]

Try using brackets to define your capture groups for your regular expression. So, let's say that you want to capture the three letters followed by the 5 digits...

objRegExp.Pattern = "([a-z]{3})(\d{5})\W"

Hope this helps!

the problem is not the resultat, i get it. my problem is here

For Each objMatch In colMatches ' Iterate Matches collection.
i = 0
valori(i + 1) = objMatch.SubMatches(i)
' MsgBox objMatch.SubMatches(0)
i = i + 1
Next objMatch

Example

in Cell A2 i have this text: " Hello text text text AAA88888 Text Text Text AAA99999) text text"
in Cell A1 i wrote the formula =TestRegExp(A2, 2) the result shuld be AAA99999
if in Cell A1 i wrote the formula =TestRegExp(A2, 1) the result shuld be AAA88888

thx

 

[IFTODE]

Solved

Solution

Public Function textRegExp(myString As String, NrCrt As Long)
'Create objects.
Dim objRegExp As RegExp
Dim RetStr As String, valori(0 To 100) As String
Dim exempl As Variant
Dim i As Long, f As Long


Set objRegExp = New RegExp ' Create a regular expression object.


objRegExp.Pattern = "([a-z]{3}\d{5})\W" 'Set the pattern by using the Pattern property.
objRegExp.IgnoreCase = True 'Set Case Insensitivity.
objRegExp.Global = True 'Set global applicability.


If (objRegExp.Test(myString) = True) Then 'Test whether the String can be compared.


'Get the matches.

Set exempl = objRegExp.Execute(myString)
f = objRegExp.Execute(myString).Count


For i = 1 To f
valori(i) = exempl(i - 1)
Next i



Set objMatch = Nothing
Set colMatches = Nothing
Set objRegExp = Nothing
End If
textRegExp = Replace(valori(NrCrt), ")", "")
End Function

THX

 

[Domenic]

It seems to me that your function can be simplified somewhat. Also, it can be re-written so that it returns a bit more meaningful information. For example, with the following function, if there are no matches, the formula returns #N/A. If, however, there are matches but NrCrt is out of bounds, it returns #REF! . Otherwise, it returns the desired value. This way, when an error value is returned, you'll know why. You'll also notice that the function uses late binding. So there's no need to set a reference to Microsoft VBScript Regular Expressions. With late binding, objects get resolved at run-time.

Public Function textRegExp(myString As String, NrCrt As Long)

    Dim objRegExp As Object 'VBScript_RegExp_55.RegExp
    Dim objMatches As Object 'VBScript_RegExp_55.MatchCollection
    
    Set objRegExp = CreateObject("VBSCript.RegExp")
    
    With objRegExp
        .Pattern = "([a-z]{3}\d{5})\W"
        .IgnoreCase = True
        .Global = True
    End With
    
    Set objMatches = objRegExp.Execute(myString)
    If (objMatches.Count = 0) Then
        textRegExp = CVErr(xlErrNA)
    ElseIf (NrCrt < 1 Or NrCrt > objMatches.Count) Then
        textRegExp = CVErr(xlErrRef)
    Else
        textRegExp = objMatches(NrCrt - 1).SubMatches(0)
    End If
    
    Set objMatches = Nothing
    Set objRegExp = Nothing


End Function

 

[IFTODE]

Thanks,

it help alot, i like your version.

 

[Domenic]

You're very welcome! And thanks for your feedback!

Cheers!