Boucle VBA en VBScript [Résolu]
NeriXs
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
A voir également:
- Vba error vbscript 280 2018
- Vbscript boucle if ne rien faire - Meilleures réponses
- Boucle vba ✓ - Forum - Visual Basic 6
- Fonction si et boucle vBA ✓ - Forum - Visual Basic 6
- Boucle vba excel - Forum - VB.NET
- [Catégorie modifiée VB6 --> VBA] Problème avec les boucles VBA - Forum - Visual Basic 6
- Sortie de boucle (VBA - Excell) - Forum - Visual Basic 6
20/23 réponses
Meilleure réponse
Bonjour,
Deux méthodes
Deux méthodes
Dim myarray
myarray = Array("1","2","3","4")
For i=0 To UBound(myarray)
MsgBox myarray(i),,"for i=" & i
Next
For Each item In myarray
MsgBox item,,"for each"
Next Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
a aidé 97 internautes ce mois-ci
Ton script corrigé en version vbs.
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
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
a aidé 97 internautes ce mois-ci
Bonjour NeriXs,
Ajout d'un tri
Ajout d'un tri
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
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
a aidé 97 internautes ce mois-ci
Ton script semble correct, excepté si tu rajoutes ":" dans le tableau myarray.
jean-marc
Non, j'ai rien dit, je viens de tester l'ajout de ":" dans myarray et texte.
jean-marc
Non, j'ai rien dit, je viens de tester l'ajout de ":" dans myarray et texte.
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
a aidé 97 internautes ce mois-ci
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
Merci cs_JMO
Décidément je ne m'en sort pas.
Voici le VBA complet que j'ai commencé a convertir:
Décidément je ne m'en sort pas.
Voici le VBA complet que j'ai commencé a convertir:
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
Une variante
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
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
Bonsoir,
Je cherche à modifier le message pour avoir :
----------------------------------------------------------
8 correspondance(s) trouvée(s).
Correspondance trouvée " \ " en position : 0
Correspondance trouvée " - " en position : 1
Correspondance trouvée " * " en position : 5
Correspondance trouvée " -" en position : 6
Correspondance trouvée " \ " en position : 51
Correspondance trouvée " - " en position : 56
Correspondance trouvée " *" en position : 57
Correspondance trouvée "* " en position : 61
----------------------------------------------------------
Un peu d'aide st possible ?
Je cherche à modifier le message pour avoir :
----------------------------------------------------------
8 correspondance(s) trouvée(s).
Correspondance trouvée " \ " en position : 0
Correspondance trouvée " - " en position : 1
Correspondance trouvée " * " en position : 5
Correspondance trouvée " -" en position : 6
Correspondance trouvée " \ " en position : 51
Correspondance trouvée " - " en position : 56
Correspondance trouvée " *" en position : 57
Correspondance trouvée "* " en position : 61
----------------------------------------------------------
Un peu d'aide st possible ?
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
Bonjour cs_JMO
Citation:
Corriger également
Je n'ai pas compris, le -1 me retourne un nombre d’occurrences -1 ce qui est faut?
Citation 2:
Dans myarray, l'expression "" provoque une erreur. Par contre OK pour " ".
Je ne voix pas non plus ? ""cela reviens a faire une recherche sur rien?
Citation:
Corriger également
strList = objDico.Count-1 & " correspondance(s)
Je n'ai pas compris, le -1 me retourne un nombre d’occurrences -1 ce qui est faut?
Citation 2:
Dans myarray, l'expression "" provoque une erreur. Par contre OK pour " ".
Je ne voix pas non plus ? ""cela reviens a faire une recherche sur rien?
Bonsoir NeriXs,
Test avec
Résultat
Pour "Dans myarray, l'expression "" provoque une erreur. Par contre OK pour " ". "
Logique: tu ne peux pas rechercher Nothing.
Test OK avec
jean-marc
Test avec
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
Résultat
Pour "Dans myarray, l'expression "" provoque une erreur. Par contre OK pour " ". "
Logique: tu ne peux pas rechercher Nothing.
Test OK avec
myarray = Array("\?", Space(1), "\,", "\*", "\!", "\-", "\/", "\'")
jean-marc
- Messages postés
- 101
- Date d'inscription
- lundi 4 mai 2015
- Dernière intervention
- 11 janvier 2018
Désolé j'ai perdu le fil je n'ai pas compris tes dernières modification.
ceci semble donner le bon résultat:
ceci semble donner le bon résultat:
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
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.