Option Explicit Const texte = "\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/" Dim myarray, item myarray = Array("\\", "\*", "-") For Each item In myarray Recherche item Next Sub Recherche (Caractere) Dim regex, matches Dim Pattern, match, msg, Sortie, i Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")" Set regex = New RegExp regex.Pattern = Pattern regex.Global = True Set matches = regex.Execute(texte) msg = "Le pattern " & Pattern & " retourne " & matches.Count & " captures" For Each match In matches For i = 1 To match.Submatches.Count - 1 Step 2 If Not (match.Submatches(i) = "") Then msg = msg & (vbcrlf & "Correspondance trouvée """ & _ match.Submatches(i) & """ en position: " & _ match.FirstIndex + Len(match.Value) - 1) End If Next Next MsgBox msg,,"recherche sur " & Caractere Set matches = Nothing Set regex = Nothing End Sub
Option Explicit Const texte = "\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/" Dim objDico Dim myarray, arrDicoItem Dim item, strList, cprovisoire Dim i, t, bpermute myarray = Array("\\", "\*", "-") Set objDico = CreateObject("Scripting.Dictionary") For Each item In myarray Recherche(item) Next ' Tri arrDicoItem = objDico.Items bpermute = True Do While bpermute = True 'Il faut au moins parcourir une fois bpermute = False 'On tourne tant que l'on bouge des valeurs For t = 1 To UBound(arrDicoItem)-1 If CInt(Split(arrDicoItem(t),": ")(1)) > CInt(Split(arrDicoItem(t + 1),": ")(1)) Then cprovisoire = arrDicoItem(t) arrDicoItem(t) = arrDicoItem(t + 1) arrDicoItem(t + 1) = cprovisoire bpermute = True End If Next Loop 'Affichage du résultat classé strList = objDico.Count & " correspondance(s) trouvée(s):" & vbcrlf For i = 0 To UBound(arrDicoItem) strList = strList & arrDicoItem(i) &vbCrLf Next Set objDico = Nothing MsgBox strList,,"Liste" WScript.Quit Sub Recherche(Caractere) Dim regex, matches Dim Pattern, match, i Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")" Set regex = New RegExp regex.Pattern = Pattern regex.Global = True Set matches = regex.Execute(texte) For Each match In matches For i = 1 To match.Submatches.Count - 1 Step 2 If Not (match.Submatches(i) = "") Then objDico.Add match.FirstIndex + Len(match.Value) - 1, _ "Correspondance trouvée """ & _ match.Submatches(i) & """ en position: " & _ match.FirstIndex + Len(match.Value) - 1 End If Next Next Set matches = Nothing Set regex = Nothing End Sub
Sub Macro1
Dim texte' As String
texte = "\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/"
'For Each Caractere In Array("\\", "\*", "-")
'Recherche Caractere, texte
'Next
Dim myarray
myarray = Array("\\", "\*", "-")
For Each item In myarray
Recherche item, texte
Next
End Sub
Sub Recherche '(ByVal Caractere As String, texte As String)
Dim Pattern ' As String
Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")" 'on fait un pattern
Dim regex ' As VBScript_RegExp_55.RegExp
Set regex = New RegExp 'New VBScript_RegExp_55.RegExp
regex.Pattern = Pattern
regex.Global = True
Dim match ' As VBScript_RegExp_55.match
Dim matches ' As VBScript_RegExp_55.MatchCollection
Set matches = regex.Execute(texte)
msg = "Le pattern " & Pattern & " retourne " & matches.Count & " captures"
Dim sortie ' As String
For Each match In matches
For i = 1 To match.Submatches.Count - 1 Step 2
If Not (match.Submatches(i) = "") Then
msg = msg & ("Correspondance trouvée """ & match.Submatches(i) & """ en position: " & match.FirstIndex + Len(match.Value) - 1)
End If
Next ' i
Next ' match
End Sub
MsgBox Recherche
Option Explicit Const texte = "\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/" Dim myarray, item, result myarray = Array("\\", "\*", "-") For Each item In myarray result = result & vbCrLf & Recherche(item) Next MsgBox result Function Recherche(Caractere) Dim regex, matches Dim Pattern, match, msg, Sortie, i Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")" Set regex = New RegExp regex.Pattern = Pattern regex.Global = True Set matches = regex.Execute(texte) msg = vbcrlf & "Le pattern " & Pattern & " retourne " & matches.Count & " captures" For Each match In matches For i = 1 To match.Submatches.Count - 1 Step 2 If Not (match.Submatches(i) = "") Then msg = msg & (vbcrlf & "Correspondance trouvée """ & _ match.Submatches(i) & """ en position: " & _ match.FirstIndex + Len(match.Value) - 1) End If Next Next Set matches = Nothing Set regex = Nothing Recherche = msg End Function
strList = objDico.Count-1 & " correspondance(s)
myarray = Array("\?", " ", "\,", "\*", "\!", "\-", "\/", "\'") 'et strList = objDico.Count-1 & " correspondance(s) 'ou strList = UBound(arrDicoItem) & " correspondance(s) For i = 0 To UBound(arrDicoItem)-1 strList = strList & i+1 & Space(1) & arrDicoItem(i) & vbCrLf Next
myarray = Array("\?", Space(1), "\,", "\*", "\!", "\-", "\/", "\'")
'Affichage du résultat classé strList = objDico.count & " correspondance(s) trouvée(s):" & vbcrlf For i = 0 To UBound(arrDicoItem) strList = strList & i+1 & Space(3) & arrDicoItem(i) & vbCrLf Next
Const texte = "\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/"
Dim objDico
Dim myarray, arrDicoItem
Dim item, strList, cprovisoire
Dim i, t, bpermute
myarray = Array("\?", " ", "\,", "\*", "\!", "\-", "\/", "\'")
Set objDico = CreateObject("Scripting.Dictionary")
For Each item In myarray
Recherche(item)
Next
' Tri
arrDicoItem = objDico.Items
bpermute = True
Do While bpermute = True 'Il faut au moins parcourir une fois
bpermute = False 'On tourne tant que l'on bouge des valeurs
For t = 0 To UBound(arrDicoItem)-1
If CInt(Split(arrDicoItem(t),": ")(1)) > CInt(Split(arrDicoItem(t + 1),": ")(1)) Then
cprovisoire = arrDicoItem(t)
arrDicoItem(t) = arrDicoItem(t + 1)
arrDicoItem(t + 1) = cprovisoire
bpermute = True
End If
Next
Loop
'Affichage du résultat classé
strList = objDico.Count & " correspondance(s) trouvée(s):" & vbcrlf
For i = 0 To UBound(arrDicoItem)
strList = strList & "(" & i+1 & ")" & " " & arrDicoItem(i) &vbCrLf
Next
Set objDico = Nothing
MsgBox strList,,"Liste"
WScript.Quit
Sub Recherche(Caractere)
Dim regex, matches
Dim Pattern, match, i
Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")"
Set regex = New RegExp
regex.Pattern = Pattern
regex.Global = True
Set matches = regex.Execute(texte)
For Each match In matches
For i = 1 To match.Submatches.Count - 1 Step 2
If Not (match.Submatches(i) = "") Then
objDico.Add match.FirstIndex + Len(match.Value) - 1, _
"Correspondance trouvée """ & _
match.Submatches(i) & """ en position: " & _
match.FirstIndex + Len(match.Value) - 1
End If
Next
Next
Set matches = Nothing
Set regex = Nothing
End Sub
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.