Discussion :

[alicemv]

Bonjour,
J'ai besoin de supprimer les termes en doublons (séparés par des points virgules) dans une cellule. Je dois le faire pour chaque ligne dans un fichier de 7000 lignes. Pour que ce soit plus simple j'ai fractionné les termes dans différentes cellules (ce n'était peut-être pas une bonne idée?), ce qui donne une première plage A2:AU2. Je voulais comparer chaque cellule de la plage A2:AU2 avec toutes les cellules à sa droite jusqu'à la cellule AU2 et indiquer le contenu en doublon dans la cellule active. Je voulais pouvoir copier la cellule dans la ligne en dessous (A3:AU3) pour descendre dans tout le fichier (comme on fait avec les formules). J'ai essayé la macro ci-dessous (fournie gracieusement par ChatGPT) mais elle ne marche pas :
Est-ce qu'une âme charitable pourrait m'aider? Je suis nulle en VBA....

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
Sub comparerCellulesAvecDialogue()
 
Dim plage1 As Range
Dim cell As Range
Dim doublon As String
 
Set plage1 = Range("A2:AU2")
 
For Each cell In plage1 ' Parcours chaque cellule de la plage1
    doublon = "" ' Réinitialise la variable doublon
    For Each c In Range(cell.Offset(0, 1), plage1.Cells(plage1.Cells.Count)) ' Parcours chaque cellule à droite de la cellule actuelle
        If cell.Value = c.Value Then ' Compare la cellule avec celle à droite d'elle
            doublon = doublon & c.Value & " " ' Ajoute le contenu de la cellule en doublon dans la variable doublon
        End If
    Next c
    If doublon <> "" Then ' Si la variable doublon contient des doublons
        cell.Value = doublon ' Écrit le contenu de la variable doublon dans la cellule active
    End If
Next cell
 
End Sub

En vous remerciant d'avance
Alice

[jurassic pork]

Hello,
par rapport à ton fichier original, tu pouvais essayer cette fonction :

Code :

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

1
2
3
4
5
6
7
8
9
10
Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ";") As String
    Dim varSection As Variant
    Dim sTemp As String
    For Each varSection In Split(sInput, sDelimiter)
        If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
            sTemp = sTemp & sDelimiter & varSection
        End If
    Next varSection
    DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)
End Function

avec ce code de test :

Code :

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

1
2
3
4
5
Sub TestSupDoublons()
Dim maChaine As String
maChaine = "banane;cerise;fraise;banane;kiwi;cerise;pêche;pomme;poire;banane;prune"
Debug.Print DeDupeString(maChaine)
End Sub

j'obtiens :

banane;cerise;fraise;kiwi;pêche;pomme;poire;prune

Ami calmant, J.P

[alicemv]

Hello,
Merci beaucoup de ta réponse.
Malheureusement je n'arrive pas à faire marcher la fonction. Je suis désolée, je suis nulle en VBA.
Je mets un extrait de mon fichier (TEST_VBA.xlsx). Le but est de trouver et supprimer les doublons dans le champs MC (mots clés)

Merci d'avance
Alice

[Franc]

Salut, avec la sub ci-dessous, tu sélectionnes les cellules dont tu veux supprimer les doublons et puis tu lances la macro et le tour est joué.

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
Sub SupprimerDoublons()
    'Déclaration des variables
    Dim cell As Range
    Dim mots() As String
    Dim mot As Variant
    Dim resultat As String
 
    'Parcourir chaque cellule sélectionnée
    For Each cell In Selection
        'Vérifier si la cellule contient des ";"
        If InStr(cell.Value, ";") > 0 Then
            'Diviser les mots dans un tableau
            mots = Split(cell.Value, ";")
            'Parcourir chaque mot du tableau
            For Each mot In mots
                'Vérifier si le mot est déjà dans la chaîne de résultat
                If InStr(resultat, mot) = 0 Then
                    'Ajouter le mot à la chaîne de résultat s'il n'y est pas déjà
                    resultat = resultat & mot & ";"
                End If
            Next mot
            'Remplacer la valeur de la cellule par la chaîne de résultat sans doublons
            cell.Value = Left(resultat, Len(resultat) - 1)
            'Réinitialiser la chaîne de résultat pour la prochaine cellule
            resultat = ""
        End If
    Next cell
End Sub

[alicemv]

waouh! C'est génial! Merci beaucoup!! :-)

[alicemv]

Hello,
Je reviens sur la macro car il me semble que si le premier terme est en doublon, ça ne le prend pas en compte. Mais ça marche bien à partir du second terme. Non?

Merci
Alice