VBA / Suppression de lignes à partir de doublons présents dans 2 colonnes

Salut la communauté,

Bonjour

Simple question mais ce ne sont pas les doublons en colonne B de la feuille 1 que vous voulez supprimer (ceux que vous avez mis en couleur rose) ?

NB : si je regarde la 1iere mention 12 en feuil3, il n'y a pas de doublon en feuil1

Crdlt

Bonjour,

Non hélas ;) ça m'aurait arrangé.

Je peux expliquer plus en détails mon raisonnement et ce que je cherche à faire (pour info je compare les valeurs présents en feuil1 colonne B et les valeurs présents en feuil2 colonne B).

Mais pour simplifier, il me faut "juste" une macro qui stocke les valeurs que j'ai dans ma colonne B de ma Feuil3 (c'est indispensable car ces valeurs vont être évincées lors de la suppression des lignes). Ensuite, si dans ma Feuille 1 colonne C une valeur est présente en double par rapport aux valeurs stockées, alors il faut supprimer la ligne entière.

Merci

Re,

Oui j'avais compris votre démarche

essayez avec ce code

Sub test()
Dim i As Integer, lig As Integer

With Sheets("Feuil3")
    For i = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        On Error Resume Next
        lig = Sheets("Feuil1").Range("C:C").Find(.Range("B" & i), LookIn:=xlValues).Row
        If lig > 0 Then Sheets("Feuil1").Rows(lig).Delete: lig = 0
    Next i
End With
End Sub

Crdlt

Re,

Merci pour le code test, cela a bien supprimer certaines valeurs en doublons mais il en manque une grande partie.

On peut peux être tenter une autre approche. En se basant sur la colonne B de ma Feuil1 et de ma Feuil3. Si il y'a un doublon alors il faut supprimer la ligne de ma Feuil1 où il y a ce doublon.

re,

Merci pour le code test, cela a bien supprimer certaines valeurs en doublons mais il en manque une grande partie.

Exact. mais cela est dû recalcul à chaque opération de suppression

Essayez plutôt le code comme ceci

Sub test()
Dim i As Integer, lig As Integer
Application.Calculation = xlCalculationManual
For i = Sheets("Feuil3").Range("B" & Rows.Count).End(xlUp).Row To 1 Step -1
    On Error Resume Next
    lig = Sheets("Feuil1").Range("C:C").Find(Sheets("Feuil3").Range("B" & i), LookIn:=xlValues).Row
    If lig > 0 Then Sheets("Feuil1").Range("C" & lig).EntireRow.Delete: lig = 0
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

Si ok pensez à cloturer

Crdlt

Re,

Impeccable ! Parfait, merci beaucoup.

Bonne fin de journée