Boucle VBA en VBScript [Résolu]

NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 18 déc. 2017 à 14:04 - Dernière réponse : NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention
- 20 déc. 2017 à 21:32
Bonjour,
Pourriez-vous m'aider à porter cette boucle VBA en Vbscript SVP?

 For Each caractere In Array("1", "2", "3")
Recherche caractere, texte
Next


Pour info Recherche fait référence a une sub "Sub Recherche"

texte = "Poste1, Poste2 et Poste3"
Afficher la suite 

Votre réponse

25 réponses

Meilleure réponse
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 18 déc. 2017 à 17:08
1
Merci
Bonjour,

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 

Merci cs_JMO 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 99 internautes ce mois-ci

Commenter la réponse de cs_JMO
Meilleure réponse
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - Modifié par cs_JMO le 18/12/2017 à 21:00
1
Merci
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

Merci cs_JMO 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 99 internautes ce mois-ci

Commenter la réponse de cs_JMO
Meilleure réponse
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 19 déc. 2017 à 13:18
1
Merci
Bonjour NeriXs,

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

Merci cs_JMO 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 99 internautes ce mois-ci

Commenter la réponse de cs_JMO
Meilleure réponse
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - Modifié par cs_JMO le 20/12/2017 à 20:52
1
Merci
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.

Merci cs_JMO 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 99 internautes ce mois-ci

Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 18 déc. 2017 à 18:43
0
Merci
Bonjour,
Merci pour l'exemple.
Que devient "Recherche caractere, texte"?
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 18 déc. 2017 à 18:53
0
Merci
Bonjour NeriXs,

Nous ne savons pas ce que contient cette Sub.
Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 18 déc. 2017 à 19:31
0
Merci
Sub Recherche(ByVal Caractere As String, texte As String)
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 18 déc. 2017 à 19:36
0
Merci
For Each item In myarray
    Recherche item, texte
Next 

Attends-tu cette réponse ???
Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 18 déc. 2017 à 20:25
0
Merci
Merci cs_JMO
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
Commenter la réponse de NeriXs
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 18 déc. 2017 à 21:10
0
Merci
Merci cs_JMO
Je ne comprenais pas le comportement du script !
Quelle grosse erreur d’avoir omis de reprendre les paramètres de la Sub
Sub Recherche (Caractere, texte)

Sans ça, j’aurais peut-être pu m’en sortir.
Encore merci ;)
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 18 déc. 2017 à 21:28
0
Merci
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
Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - Modifié par NeriXs le 18/12/2017 à 21:42
0
Merci
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 ?
Commenter la réponse de NeriXs
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - Modifié par NeriXs le 19/12/2017 à 21:51
0
Merci
Bonjour,
Merci pour cette belle démonstration!
J'ai un désordre sur le 1er caractère quand celui-ci n'est pas au début due Const texte et pas au début de l'Arrey.
Testé avec ceci:
myarray = Array("\?", "", "\,", "\*", "\!", "\-", "\/", "\'") 
  
Commenter la réponse de NeriXs
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 19 déc. 2017 à 21:56
0
Merci
Ligne 22
For t = 0 To UBound(arrDicoItem)-1 

A la place de:
For t = 1 To UBound(arrDicoItem)-1

c'est bien ça?
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 20 déc. 2017 à 08:03
0
Merci
Bonjour NeriXs ,

Oui il faut bien mettre
For t = 0 To UBound(arrDicoItem)-1
.
Corriger également
strList = objDico.Count-1 & " correspondance(s)
.
Dans myarray, l'expression "" provoque une erreur. Par contre OK pour " ".
Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - Modifié par NeriXs le 20/12/2017 à 17:44
0
Merci
Bonjour cs_JMO

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?
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 20 déc. 2017 à 18:01
0
Merci
Bonsoir NeriXs,

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
Commenter la réponse de cs_JMO
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - Modifié par cs_JMO le 20/12/2017 à 18:26
0
Merci
Désolé, l'insertion d'une image ne fonctionne plus depuis "la révolution" du site !!

jean-marc

Message à supprimer par un modérateur, image affichée après plusieurs refresh.
Merci,
Commenter la réponse de cs_JMO
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 20 déc. 2017 à 19:41
0
Merci
Il y a bien un problème! dans t'as capture n’apparaît pas:
19Correspondane trouvée "/" en position: 62
Commenter la réponse de NeriXs
cs_JMO 1855 Messages postés jeudi 23 mai 2002Date d'inscription 24 juin 2018 Dernière intervention - 20 déc. 2017 à 19:48
0
Merci
Il te suffit donc de mettre
'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


jean-marc
NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 20 déc. 2017 à 20:36
Désolé j'ai perdu le fil je n'ai pas compris tes dernières modification.

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
Commenter la réponse de cs_JMO

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.