Boucle VBA en VBScript

Résolu
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020
- Modifié le 25 nov. 2019 à 11:25
 jojo - 24 nov. 2019 à 18:48
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

cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
18 déc. 2017 à 17:08
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 
1
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Modifié le 18 déc. 2017 à 21:00
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
1
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
19 déc. 2017 à 13:18
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
1
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Modifié le 20 déc. 2017 à 20:52
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.
1

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

18 déc. 2017 à 18:43
Bonjour,
Merci pour l'exemple.
Que devient "Recherche caractere, texte"?
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
18 déc. 2017 à 18:53
Bonjour NeriXs,

Nous ne savons pas ce que contient cette Sub.
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

18 déc. 2017 à 19:31
Sub Recherche(ByVal Caractere As String, texte As String)
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Modifié le 25 nov. 2019 à 11:26
For Each item In myarray
    Recherche item, texte
Next 

Attends-tu cette réponse ???
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

Modifié le 25 nov. 2019 à 11:26
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
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

Modifié le 25 nov. 2019 à 11:27
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 ;)
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
18 déc. 2017 à 21:28
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
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

Modifié le 18 déc. 2017 à 21:42
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 ?
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

Modifié le 19 déc. 2017 à 21:51
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("\?", "", "\,", "\*", "\!", "\-", "\/", "\'") 
  
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

19 déc. 2017 à 21:56
Ligne 22
For t = 0 To UBound(arrDicoItem)-1 

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

c'est bien ça?
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
20 déc. 2017 à 08:03
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 " ".
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

Modifié le 20 déc. 2017 à 17:44
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?
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
20 déc. 2017 à 18:01
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
0
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Modifié le 20 déc. 2017 à 18: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,
0
NeriXs
Messages postés
116
Date d'inscription
lundi 4 mai 2015
Statut
Membre
Dernière intervention
18 août 2020

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

Modifié le 25 nov. 2019 à 11:28
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
0
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
0