XL 2016 Supprimer les doublons qui commencent par…

[virgie]

Bonjour,
J’ai un fichier dans lequel figure plusieurs fois diverses occurrences (« Auteur : … », « Livre : … », …).
Je souhaiterais supprimer les doublons dans ma feuille lorsque l’occurrence commence par le mot Auteur.
Savez-vous si cela est possible ??
Merci par avance pour vos réponses ☺️

 

[nat54]

Bonjour,
Un petit fichier exemple ?

 

[virgie]

Oui bien sûr, merci...
J'aimerais qu'il n'y ait qu'une seule fois l'auteur suivi de sa liste de livres et d'acheteurs.

 

[job75]

Bonjour virgie, nat54, JHA,

Je souhaiterais supprimer les doublons dans ma feuille lorsque l’occurrence commence par le mot Auteur.

Voyez le fichier joint et les macros des boutons :

Sub Supprimer_doublons()
Dim ncol%, d As Object, tablo, resu(), i&, x$, flag As Boolean, n&, j%
ncol = 4 'nombre de colonnes
Set d = CreateObject("Scripting.Dictionary")
With Feuil1 'CodeName
    tablo = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, ncol)  'matrice, plus rapide
    ReDim resu(1 To UBound(tablo), 1 To ncol)
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        flag = False
        If x Like "Auteur*" Then
            If Not d.Exists(x) Then
                d(x) = ""
                n = n + 2
                flag = True
            End If
        ElseIf x Like "Livre*" Then
            n = n + 2
            flag = True
        ElseIf x <> "" Then
            n = n + 1
            flag = True
        End If
        If flag Then For j = 1 To ncol: resu(n, j) = tablo(i, j): Next j
    Next i
    With .[A2]
        If n Then .Resize(n, ncol) = resu
        .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
    End With
End With
End Sub

Sub Réinitialiser()
Feuil2.[A:D].Copy Feuil1.[A1]
End Sub

Les lignes vides de séparation sont conservées.

La macro est très rapide car elle utilise des tableaux VBA et le Dictionary.

A+