Discussion :

[Invité]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

J'essaie d'obtenir:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Je définis la longueur et la position:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
StrOutput = Mid(MyTxt, 1, 6)
MsgBox StrOutput

Mon MsgBox me retourne bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

[a-z]+

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

Un peu d'aide SVP?

[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

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

[ProgElecT]

Par contre la formule ....

A essayer avec différents strSource

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

OUHaHOU là ca envois du lourd !!!
Petite question, la déclaration de la chaine strSource doit elle rester dans la Function ?
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.
En tout cas belle prouesse !
Je viens de faire quelques tests pour le moment RAS le code traite et ne fléchit pas

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

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.

[ericlm128]

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

Code vbs :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ProgElecT]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ericlm128]

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

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

[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]+"

[Invité]

Bonjour,

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

Merci ProgElecT pour la correction et les commentaires.

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

Encore une fois Respect.

[ProgElecT]

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

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.

[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]+