[VBS] Traitement de chaine de caractères

Version imprimable

Bonjour,

Le code suivant permet de supprimer les caractères consécutifs identique.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Function DeleteConsecutiveChars (MyTxt) Dim I Dim StrOutput StrOutput = Mid(MyTxt, 1, 1) MsgBox StrOutput For I = 1 To Len(MyTxt) -1 If Mid(MyTxt, I, 1)<> Mid(MyTxt, I + 1, 1) Then StrOutput = StrOutput & Mid(MyTxt, I + 1, 1) Next DeleteConsecutiveChars = StrOutput End Function strSource = "AAAeeelmA12fggg35526666m" msgbox DeleteConsecutiveChars (strSource)
J'essaie de le modifier pour permettre la suppression de groupes de caractères identiques.
La chaine est:

Code:

"[a-z]+[a-z]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+"

J'essaie d'obtenir:

Code:

"[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+"

Je définis la longueur et la position:
Code:

1 2 StrOutput = Mid(MyTxt, 1, 6) MsgBox StrOutput
Mon MsgBox me retourne bien

Code:

[a-z]+

Je ne parviens pas définir les bonnes valeurs des fonctions de traitement de chaine.

Un peu d'aide SVP?

24/11/2017, 16h02
ericlm128

En reprenant ton exemple AAAeeelmA12fggg35526666m.
Quels sont les blocs de caractères identiques et a quoi doit correspondre la sortie ?

Je dirais bien qu'un bloc est au minimum composé de deux caractères.
Le seul que je vois est dans la chaine 6666 qui a deux blocs 66
Le résultat sera donc AAAeeelmA12fggg3552m avec inclusion ou sans AAAeeelmA12fggg355266m
24/11/2017, 17h13
ProgElecT

Salut

Ce que j'ai compris,
si strSource = [a-z]+[a-z]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+
récupération = [a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+
Car il y a répétition du groupe de caractères consécutifs identique [a-z]+
Par contre la formule ....

Citation:

Par contre la formule ....

A essayer avec différents strSource

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function DelGroupChars(MyTxt)
    Dim T, U, V, Deb2
    Dim StrOutput, GrpChar
'strSource = "[a-z]+[a-z]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+"
'                         [a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+            ( )[0-9]+
    V = CInt(Len(MyTxt) / 2)
    StrOutput = MyTxt
    For T = 1 To Len(StrOutput) - 1
        V = CInt(Len(StrOutput) / 2)
        For U = 2 To V
            GrpChar = Mid(StrOutput, T, U)
            Deb2 = InStr(T + U - 1, StrOutput, GrpChar, vbBinaryCompare)
            If Deb2 = U + T Then
                If T = 1 Then
                    StrOutput = Replace(StrOutput, GrpChar, "", Deb2, 1, vbBinaryCompare): T = T - 1
                    Else
                    StrOutput = Left(StrOutput, Deb2 - 1) & Replace(StrOutput, GrpChar, "", Deb2, 1, vbBinaryCompare): T = T - 1
                End If
                Exit For
            End If
        Next
    Next
    DelGroupChars = StrOutput
End Function

24/11/2017, 22h07
Invité

:furieux: OUHaHOU là ca envois du lourd !!! :furieux:
Petite question, la déclaration de la chaine strSource doit elle rester dans la Function ? :koi:
Habituellement je sors tout ce qui est appels ou déclarations.

Pour en revenir au code là j’ai besoin d’explication et pas des moindres !

A la 1er lecture je n’ai pas déchiffré la moitié du code. :marteau: :mur: :scarymov:
En tout cas belle prouesse ! :king::bravo::roi:
Je viens de faire quelques tests pour le moment RAS le code traite et ne fléchit pas :ccool:
:merci:
24/11/2017, 22h48
ProgElecT

En fait les lignes 4 et 5 sont en commentaire, elles m'ont servies le temps du debug, j'ai oublié de les supprimer.
Je triche, j'utilise VB6 et antérieur pour debuguer, run pas à pas, variables espions .......

Citation:

Envoyé par NeriXs

Je viens de faire quelques tests pour le moment RAS le code traite et ne fléchit pas

J'attendais cette information, c'est pourquoi je n'ai pas commenté le code, promis, demain tu auras plus d’explications.

Pour ma part je ne comprend pas les résultat obtenus

Code:

1
2
3
4
5
6
' DelGroupChars("abab") ' Résultat : 
' DelGroupChars("#abab") ' Résultat : #ab
' DelGroupChars("ababab") ' Résultat : ab
' DelGroupChars("ababcdabcdcd") ' Résultat : cdabcd
' DelGroupChars("#ababcababc") ' Résultat : #abcabc
' DelGroupChars("[a-zP]+[a-zP]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+") ' Résultat : [a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+

Saut à vous deux

Une petite rectification du code grace à ericlm128 et ses exemples lignes 4 et 6
DelGroupChars("ababcdabcdcd") ' Résultat : ~~cdabcd~~ ---> abcd)
DelGroupChars("[a-zP]+[a-zP]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+") ' Résultat : ~~[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+~~ ---> [a-zP]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+

le code rectifié et commenté

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Function DelGroupChars(MyTxt)
    Dim T, U, V, Deb2
    Dim StrOutput, GrpChar
    StrOutput = MyTxt ' si aucun changement de MyTxt, DelGroupChars sera égal
    For T = 1 To Len(StrOutput) - 1
        V = CInt(Len(StrOutput) / 2) ' au plus, la suite de caractère ne pourra être que la moitié de la phrase
 
        For U = 2 To V ' u=2 car un groupe de caractères à un minimum de 2 caractères 
            GrpChar = Mid(StrOutput, T, U) 'on augmente le taille du groupe de caractères à rechercher, à chaque tour de boucle
            Deb2 = InStr(T + U - 1, StrOutput, GrpChar, vbBinaryCompare)
            If Deb2 = T + U Then ' si un même groupe de caractères suit immédiatement
                If T = 1 Then ' si T est le début de la phrase
                    StrOutput = Right(StrOutput, Len(StrOutput) - U) ' supprime au début de la phrase le groupe de caractères identique
                    T = T - 1 ' pour ré-sélectionné le groupe de caractères depuis le début de la phrase
                    Else
                    ' on récupéré la partie gauche de la phrase avant la répétition du groupe de caractères trouvé
					' auquel on ajoute la partie droite de la phrase sans la  répétition du groupe de caractères trouvé
					' quand le 3ém paramétré de la fonction Replace est <> 1, replace renvoie la partie droite
					' de la phrase en commençant à la valeur du 3ém paramètre
					StrOutput = Left(StrOutput, Deb2 - 1) & Replace(StrOutput, GrpChar, "", Deb2, 1, vbBinaryCompare)
                    T = T - 1
                End If
                Exit For
            End If
        Next
 
    Next
    DelGroupChars = StrOutput
End Function

le même code non commenté

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function DelGroupChars(MyTxt)
    Dim T, U, V, Deb2
    Dim StrOutput, GrpChar
    StrOutput = MyTxt
    For T = 1 To Len(StrOutput) - 1
        V = CInt(Len(StrOutput) / 2)
        For U = 2 To V 
            GrpChar = Mid(StrOutput, T, U)
            Deb2 = InStr(T + U - 1, StrOutput, GrpChar, vbBinaryCompare)
            If Deb2 = T + U Then 
                If T = 1 Then
                    StrOutput = Right(StrOutput, Len(StrOutput) - U): T = T - 1
                    Else
                    StrOutput = Left(StrOutput, Deb2 - 1) & Replace(StrOutput, GrpChar, "", Deb2, 1, vbBinaryCompare): T = T - 1
                End If
                Exit For
            End If
        Next
    Next
    DelGroupChars = StrOutput
End Function

25/11/2017, 10h28
ericlm128

Je ne suis pas non plus sur de comprendre ce résultat, la recherche doit être ré-effectué sur chaque résultats ?

Citation:

DelGroupChars("ababcdabcdcd") ' Résultat : cdabcd ---> abcd)

Je m'explique, si j'effectue une recherche des groupes similaires de caractères, en parcourant de gauche à droite et en recherchant en priorité les plus grand groupe voici ce que je trouve :
ababcdabcdcd
Résultat : abcdabcd

Si on rejoue la recherche sur le résultat :
abcdabcd
Résultat : abcd

A noter que le sens de la recherche peux amener à des résultats différents.
ababcbc : de gauche à droite -> abcbc
ababcbc : de droite à gauche -> ababc

De même que le sens de traitement de :
- la taille de chaque groupe (chercher en premier les plus petit ou les plus grand)
- le nombre d’occurrence de chaque groupe (trouver ceux qui ont le plus d’occurrence en premier ou l'inverse)

Bon j'arrête de vous embêter, c'était juste quelques remarques pour avoir conscience que le résultat n'est pas une science exacte, mais dépend de la façon dont l'on traite les groupes similaires.

Sinon bien joué ProgElecT, l'exercice n'était pas forcément simple :)
25/11/2017, 11h37
ProgElecT

Re

@ericlm128, je suis d'accord avec ton analyse, d'ailleurs j'ai eu du mal à tomber sur ce que voulait NeriXs.

En tout cas cela correspond à sa demande
De "[a-z]+[a-z]+[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+[a-z]+[a-z]+( )[0-9]+"
- à "[a-z]+( )[A-Z]+( )[0-9]+(.)[a-z]+( )[0-9]+"
25/11/2017, 15h10
Invité

Bonjour,

Je reste sur le C…. 8O
Merci à ericlm128 pour les testes et cet échange au sommet avec ProgElecT. :chin:

Merci ProgElecT pour la correction et les commentaires. :merci:

Attention au caractère $ qui es venu se glisser derrière Right ligne 12. :nono:

Encore une fois Respect. :ave: :bravo: :hola:

:resolu:
25/11/2017, 16h44
ProgElecT

Citation:

Envoyé par NeriXs

Bonjour,
.......
Attention au caractère $ qui es venu se glisser derrière Right ligne 12. :nono:
......

:arf: et oui, je n'ai pas refait l’essai en VBScript, Right$, en VB6 et antérieur, le $ permet d'avoir l'information des paramètres de la fonction au cours de la rédaction du code.
30/11/2017, 10h52
Invité

Bonjour,
Je vais essayer de m'expliquer clairement.
Vu que le code détecte les "doublons"
Est-il possible dans le cas de détection de doublons d'ajouter le caractère "+" après le groupe de caractères restant?
(Seulement s'il y avait doublons)
Exemple:
StrSource = [A-Z][A-Z][a-z]( )[a-z][a-z][a-z]-[A-Z]23[a-z]@[a-z][a-z]
Récupération = [A-Z]+[a-z]( )[a-z]+-[A-Z]23[a-z]@[a-z]+