Suppression de doublon(s) sur le résultat d'un filtre

Bonjour,

c'est mon premier post, je m'excuse au cas ou la forme ne corresponde pas à vos codes habituels.

Je souhaiterai pouvoir supprimer les doublons de ligne en filtrant sur la colonne d'un tableau mais en ne supprimant que les doublons pour le résultat de ce filtre et non pas tout les doublons de la feuille.

Sub filtre_BL()

    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim BL As String
    Dim SCALP As String

    BL = InputBox("quel est le numéro de BL ?")
    SCALP = Mid(BL, 4, 6)
    ActiveSheet.Range("A3").AutoFilter field:=3, Criteria1:=SCALP

 End Sub

ce morceau de code me permet de filtrer sur l'information que je recherche.

cet autre morceau de code (que j'ai récupérer sur un forum) filtre bien ce que je cherche mais il supprime tout les doublons de la page, alors que je ne souhaite la suppression que des données générées par mon filtre.

Sub SupprimeDoublons()
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
    Dim BL As String
    Dim SCALP As String

    BL = InputBox("quel est le numéro de BL ?")
    SCALP = Mid(BL, 4, 6)
    ActiveSheet.Range("A3").AutoFilter field:=3, Criteria1:=SCALP

   [b] 'Définit la plage de cellules pour la recherche de doublons
    Set Plage = Worksheets("Feuil1").Range("c2:c14")[/b]

    On Error Resume Next
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        'Création d'une collection de données uniques (sans doublons)
        Un.Add Cell, CStr(Cell)

        'Une erreur survient si l'élément existe dans la collection.
        'La procédure enregistre le numéro de ligne correspondant dans un tableau.
        If Err.Number <> 0 Then
            x = x + 1
            ReDim Preserve Tableau(1 To x)
            Tableau(x) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0

    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then Exit Sub

    'Fige l'écran pendant la suppression des lignes
    Application.ScreenUpdating = False

    'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
        Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete
    Next x

    Application.ScreenUpdating = True

    'Range("A1").AutoFilter

    'With Worksheets("Feuil1")
    'If .FilterMode = True Then .ShowAllData
    'End With
End Sub[Inline][/Inline]

j’espère avoir été clair.

merci de votre aide.

Bonjour,

il faut enlever la déclaration de variable SCALP

Dim SCALP As String

de la macro filtre_BL

pour la déclarer Public en haut du module (extérieur au macro)

Public SCALP As String

de cette manière tu peux l'utiliser dans l'autre macro SupprimeDoublons

Public SCALP As String

Sub filtre_BL()
Dim Plage As Range, Cell As Range
Dim Un As New Collection
Dim Tableau() As Integer
Dim x As Integer
Dim BL As String

BL = InputBox("quel est le numéro de BL ?")
SCALP = Mid(BL, 4, 6)
ActiveSheet.Range("A3").AutoFilter field:=3, Criteria1:=SCALP
End Sub

Sub SupprimeDoublons()
Dim Plage As Range, Cell As Range
Dim Un As New Collection
Dim Tableau() As Integer
Dim x As Integer
Dim BL As String

'Définit la plage de cellules pour la recherche de doublons
Set Plage = Worksheets("Feuil1").Range("c2:c14")

On Error Resume Next
'Boucle sur les cellules de la plage cible
For Each Cell In Plage
    'Création d'une collection de données uniques (sans doublons)
    Un.Add Cell, CStr(Cell)

    'Une erreur survient si l'élément existe dans la collection.
    'La procédure enregistre le numéro de ligne correspondant dans un tableau.
    If Err.Number <> 0 And Cell = SCALP Then  '-------------------------------------------------------------------test
        x = x + 1
        ReDim Preserve Tableau(1 To x)
        Tableau(x) = Cell.Row
        Err.Clear
    End If
Next Cell
On Error GoTo 0

'On sort si aucun doublon n'a été trouvé.
If x = 0 Then Exit Sub

'Fige l'écran pendant la suppression des lignes
Application.ScreenUpdating = False

'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
For x = UBound(Tableau) To LBound(Tableau) Step -1
    Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete
Next x

Application.ScreenUpdating = True

'Range("A1").AutoFilter

'With Worksheets("Feuil1")
'If .FilterMode = True Then .ShowAllData
'End With
End Sub

Bonjour Isabelle,

merci pour ton aide tout d'abord !

Lorsque je lance la deuxième macro, il ne se passe rien ??

j'ai rajouté le fichier en pj

Salut Dadou,

Salut Isa,

difficile de travailler avec un mot de passe...

Tu veux donc éliminer les lignes-doublons à partir des valeurs en colonne [C] ? Soit !

Mais, sur quelle base choisir les lignes à éliminer quand les valeurs en [H-I-J] sont différentes ?

Doit-on garder la première, la dernière ?

A+

Bonjour,

Erreur de débutant pour le mdp, désolé.

Effectivement, je souhaite supprimer les doublons mis en évidence par le filtre sur la colonne C !

Je souhaite garder uniquement la première ligne de ce filtre quelque soit le nombre de ligne générées.

Idéalement, j'aimerais également vider la cellule D de cette ligne restante (elle pilotera automatiquement la cellule I) et enfin choisir comme cellule active la J.

J'ai réussi grâce à la macro filtre_BL à faire apparaître les lignes concernées par la valeur que je cherche.

La macro SupprimeDoublons fonctionnait aussi mais elle supprime tout les doublons de la feuille !!!

Je souhaite que l'on puisse combiner les deux macros en une mais que seuls les doublons mis en évidence par le filtre soit supprimé

J’espère avoir été plus clair que la première fois.

merci de votre aide