Boucle VBA en VBScript [Résolu]

Question

Posez votre question Signaler Répondre au sujet

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

VBScript (VBS) Posez votre question Signaler Répondre au sujet

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

25 réponses

Répondre au sujet

Signaler 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 à 18:43

0

Utile

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

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 18 déc. 2017 à 18:53

0

Utile

Bonjour NeriXs,

Nous ne savons pas ce que contient cette Sub.

Signaler 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 à 19:31

0

Utile

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

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 18 déc. 2017 à 19:36

0

Utile

For Each item In myarray
    Recherche item, texte
Next

Attends-tu cette réponse ???

Signaler 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 à 20:25

0

Utile

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

Signaler 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

Utile

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

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 18 déc. 2017 à 21:28

0

Utile

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

Signaler 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 18/12/2017 à 21:42

0

Utile

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 ?

Signaler 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

Utile

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

Signaler 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

Utile

Ligne 22

For t = 0 To UBound(arrDicoItem)-1

A la place de:

For t = 1 To UBound(arrDicoItem)-1

c'est bien ça?

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 20 déc. 2017 à 08:03

0

Utile

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

Signaler 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 20/12/2017 à 17:44

0

Utile

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?

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 20 déc. 2017 à 18:01

0

Utile

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

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - Modifié par cs_JMO le 20/12/2017 à 18:26

0

Utile

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,

Signaler Commenter la réponse de NeriXs

NeriXs 101 Messages postés lundi 4 mai 2015Date d'inscription 11 janvier 2018 Dernière intervention - 20 déc. 2017 à 19:41

0

Utile

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

Signaler Commenter la réponse de cs_JMO

cs_JMO 1838 Messages postés jeudi 23 mai 2002Date d'inscription 1 avril 2018 Dernière intervention - 20 déc. 2017 à 19:48

0

Utile

1

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

1 2 Suivant

Accepted Answer

+1

Utile

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

Cette réponse vous a-t-elle aidé ? Oui Non

Accepted Answer

+1

Utile

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

Cette réponse vous a-t-elle aidé ? Oui Non

Accepted Answer

+1

Utile

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

Cette réponse vous a-t-elle aidé ? Oui Non

Accepted Answer

+1

Utile

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.

Cette réponse vous a-t-elle aidé ? Oui Non

Boucle VBA en VBScript [Résolu]

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !