1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. VBScript (VBS)

Boucle VBA en VBScript [Résolu]

Signaler
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
 -
 jojo -
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"

23 réponses

1 2
Réponse 1 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Réponse 2 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Réponse 3 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Réponse 4 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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.
Réponse 5 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
Bonjour,
Merci pour l'exemple.
Que devient "Recherche caractere, texte"?
Réponse 6 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
Bonjour NeriXs,

Nous ne savons pas ce que contient cette Sub.
Réponse 7 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
Sub Recherche(ByVal Caractere As String, texte As String)
Réponse 8 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26 
For Each item In myarray
    Recherche item, texte
Next

Attends-tu cette réponse ???
Réponse 9 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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
Réponse 10 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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 <bold>(Caractere, texte)</bold>

Sans ça, j’aurais peut-être pu m’en sortir.
Encore merci ;)
Réponse 11 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Réponse 12 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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 ?
Réponse 13 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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("\?", "", "\,", "\*", "\!", "\-", "\/", "\'") 
  
Réponse 14 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
Ligne 22 
For t = 0 To UBound(arrDicoItem)-1

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

c'est bien ça?
Réponse 15 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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 " ".
Réponse 16 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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?
Réponse 17 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Réponse 18 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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,
Réponse 19 / 23
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
Il y a bien un problème! dans t'as capture n’apparaît pas:
19Correspondane trouvée "/" en position: 62
Réponse 20 / 23
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
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
Signaler
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
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
Signaler

hey je suis debutant j'ai juste compris comment faire mon programme mais pour le terminer j'ai juste besoin de faire une boucle mais je ne comprend pas comment marches vos boucle :/
help me please
Répondre Posez votre question