Posez votre question Signaler

Boucle VBA en VBScript [Résolu]

Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
 -
VBScript (VBS) Posez votre question Signaler
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

Répondre au sujet

20/23 réponses

Meilleure réponse
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_JMO
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_JMO
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_JMO
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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.

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

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

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

Attends-tu cette réponse ???
Commenter la réponse de cs_JMO
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 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
Signaler Commenter la réponse de NeriXs
Messages postés
101
Date d'inscription
lundi 4 mai 2015
Dernière intervention
11 janvier 2018
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
Signaler Commenter la réponse de cs_JMO
Messages postés
1855
Date d'inscription
jeudi 23 mai 2002
Dernière intervention
24 juin 2018
 26
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
Signaler Commenter la réponse de NeriXs
NeriXs
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: 

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

Votre réponse

Répondre au sujet
Posez votre question
1 2 Suivant
S'inscrire maintenant

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.