Boucle VBA en VBScriptRésolu

Question

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"

cs_JMO · Answer

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

NeriXs · Answer

Bonjour,
Merci pour l'exemple.
Que devient "Recherche caractere, texte"?

cs_JMO · Answer

Bonjour NeriXs,

Nous ne savons pas ce que contient cette Sub.

NeriXs · Answer

Sub Recherche(ByVal Caractere As String, texte As String)

cs_JMO · Answer

For Each item In myarray
    Recherche item, texte
Next 
Attends-tu cette réponse ???

NeriXs · Answer

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

cs_JMO · Answer

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

NeriXs · Answer

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 ;)

cs_JMO · Answer

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

NeriXs · Answer

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 ?

cs_JMO · Answer

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

NeriXs · Answer

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("\?", "", "\,", "\*", "\!", "\-", "\/", "\'")

NeriXs · Answer

Ligne 22 
For t = 0 To UBound(arrDicoItem)-1 
 A la place de:
For t = 1 To UBound(arrDicoItem)-1 
c'est bien ça?

cs_JMO · Answer

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 " ".

NeriXs · Answer

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?

cs_JMO · Answer

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

cs_JMO · Answer

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,

NeriXs · Answer

Il y a bien un problème! dans t'as capture n’apparaît pas:
19Correspondane trouvée "/" en position: 62

cs_JMO · Answer

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

cs_JMO · Answer

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.

Boucle VBA en VBScript

23 réponses

Votre réponse