Supprimer les doublons consécutifs dans la même cellule

Fermé
Xray1983 Messages postés 1 Date d'inscription mardi 5 avril 2022 Statut Membre Dernière intervention 5 avril 2022 - Modifié le 5 avril 2022 à 16:09
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 7 mai 2022 à 13:44
Bonjour à tous,

Je suis débutant avec VBA - EXCEL, J'aurais besoin de vote aide SVP.
J'ai un tableau Excel de plusieurs colonnes, les cellules de la colonne N° 24 contiennent des valeurs déferlantes

La ligne suivante est un exemple de valeur d'une cellule : *AA1234*T18057J *AA1234* M25857H *CT9853* CRG057H *AA1234* C98052G M18052F *NT3578* A1G052F TR8052E ZA8052D *QI364D* *LOCAL* RTI44C C880G1B *HHJIOP* C78051A LOCAL* H180CCB *HHJIOP* B25857H *MOP81R* L18R03B B18IP3A *LOCAL CRG057H C98052G *AA1234* TB85G2E

Résultat ex souhaitait dans une cellule : *AA1234* *CT9853* *AA1234* *NT3578* *QI364D* *HHJIOP* *MOP81R* *AA1234*

Le résultat obtenu de mon code (il supprime toutes les valeurs en double): *AA1234* *CT9853* *NT3578* *QI364D* *HHJIOP* *MOP81R*

Mon objectif est de conserver uniquement toutes les valeurs entre deux étoiles et de supprimer tout le reste y compris : *LOCAL* ou *LOCAL ou LOCAL* et y compris la deuxième valeur en double consécutive entre deux étoiles comme *AA1234* et *HHJIOP* (doublons consécutifs)


En vous remerciant par avance

voici le code que j'ai pu développer:

Public Sub SplitCarte2()

Dim Ligne, Colonne, TestLoc, LigneMax As Integer
Dim Onglet, Carte2, ItiLocaux As String
Dim Tstring() As String

Onglet = ActiveSheet.Name

Ligne = 3
Colonne = 24
LigneMax = Range("X" & Rows.Count).End(xlUp).Row + 1

Do While Ligne <= LigneMax

ItiLocaux = ""
Carte2 = Sheets(Onglet).Cells(Ligne, Colonne).Value

Tstring() = Split(Carte2)

For Each Elem In Tstring()

TestLoc = InStr(1, Elem, "*")
If TestLoc = 1 And Elem <> "*LOCAL*" Then
If TestLoc = 1 And Elem <> "LOCAL*" Then
If TestLoc = 1 And Elem <> "*LOCAL" Then
If InStr(1, ItiLocaux, Elem, 1) = 0 Then
ItiLocaux = ItiLocaux & Elem
End If
End If
End If
End If

Next

Sheets(Onglet).Cells(Ligne, Colonne).Value = ItiLocaux
Ligne = Ligne + 1
Loop

End Sub
A voir également:

1 réponse

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
7 mai 2022 à 13:44
Bonjour

Pour éliminer les doublons, le plus simple c'est le dictionnaire : http://boisgontierj.free.fr/pages_site/Dictionnaire.htm#ListeSansDoub
0