Comparer et extraire les non doublons

Bonjour à tout le monde ;

j viens vers vous pour solliciter votre aide ;pour faire la comparaisons entre code BT de la feuille 1 et code BT de la feuille 2 les doublons et extraire sur la feuille résultat le reste c'est à dire les non doublons .

ci-joint le fichier

Bonjour,

Dans la feuille résultat, tu fais un collage des données de la Feuil1,

puis tu colles à la suite celles de la Feuil2,

et tu supprimes les doublons :

DONNEES > Outils de données / Supprimer les doublons.

A+

Bonjour,

Si tu veux un truc plus ou moins automatique j'ai fais un gros bricolage avec des formules, je suis sur qu'on peut faire beaucoup plus simple,

et si un VBiste passe par là ce sera encore mieux .

Mais je pense que c'est utilisable en l'état.

A tester

EDIT : Je viens de voir un problème dans mon raisonnement ! je ré uploaderais le fichier si je trouve une solution

Bonjour @ tous,

Salut frangy,

une autre façon de faire par formule, mais c'est un peu lent.

Voir PJ

@ + +

Bonjour,

Sub EliminerDoublons()
    Dim Tnd(), d As Object, k, n%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("Feuil1")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d(.Cells(i, 1).Value) = .Cells(i, 2)
        Next i
    End With
    With Worksheets("Feuil2")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            If d.exists(.Cells(i, 1).Value) Then
                d.Remove (.Cells(i, 1).Value)
            Else
                d(.Cells(i, 1).Value) = .Cells(i, 2)
            End If
        Next i
        ReDim Tnd(d.Count, 1)
        Tnd(0, 0) = .Cells(1, 1): Tnd(0, 1) = .Cells(1, 2): n = 0
    End With
    For Each k In d.keys
        n = n + 1: Tnd(n, 0) = k: Tnd(n, 1) = d(k)
    Next k
    With Worksheets("résultat")
        .UsedRange.ClearContents
        .Range("A1").Resize(n + 1, 2).Value = Tnd
        .Columns("A:B").AutoFit
    End With
End Sub

On peut encore éventuellement peaufiner la mise en forme...

Cordialement.

Bonjour MFerrand,

Merci ça fonctionne

problème résolu ! :

Et merci à tous les autres !

(on doit sentir le fuel ...)

A+

Bonjour à tous

Une version macro qui donne des résultats différents.

S'agissant de comparer deux colonnes de deux feuilles différentes, j'ai cherché à sortir les valeurs qui étaient sur une feuille et pas sur l'autre.

Mais peut-être suis-je dans l'erreur ?

Bye !

Bonjour GMB

Il me semble que tes résultats sont les mêmes que les miens ! Et dans le même ordre !

Cordialement.

Bonjour MFerrand

Toutes mes excuses : je n'avais pas vu toutes les réponses.

Les aurais-je vues que je n'aurais pas répondu : à quoi bon si le problème est résolu et que ma réponse n'apporte rien de plus ?

Bye !

Cela diversifie... Il est vrai que l'on ne peut à la fois élaborer une réponse et regarder les autres, surtout sur certains sujets où le nombre de réponses s'accroît vite. Cela m'arrive assez souvent aussi lorsque j'arrive après plusieurs réponses de n'avoir rien à ajouter... et même parfois de voir en actualisant que la réponse que je m'apprêtais à poster vient juste d'être fournie de façon strictement identique (surtout quand il s'agit de formules, en VBA on a plus facilement de la diversité, même quand les méthodes utilisées sont semblables).

Cordialement.

merci à tout le monde.

Bonjour à tous,

J'avais commencé un truc en VBA mais comme il y avait des réponses je n'avais pas publié ; je me lance.

On n'utilise ni tableau, ni dictionary. Juste une formule qui renvoie #N/A si la ligne est un doublon sur le champ 'Code BT' et du tri.

Une fonctionnalité ajoutée sans doute inutile : pour chaque tableau source, on ôte d'abord les doublons propres à chaque tableau pour n'avoir que des enregistrements uniques. Si chaque tableau source ne comporte aucun doublon en son sein, alors on retombe sur les résultats des autres méthodes.

Le traitement est relativement rapide avec un grand nombre de lignes. Le code est un peu commenté dans le fichier joint.

Sub singleton()
Dim PremLigR&, DerLigR&, t0
   t0 = Timer
   Application.ScreenUpdating = False
   With Sheets("résultat")
      .Activate
      .Range("a:d").Clear
      Sheets("Feuil1").Range("a1").CurrentRegion.Copy .Range("a1")
      .Range("a1").CurrentRegion.RemoveDuplicates Columns:=Array(1), Header:=xlYes
      PremLigR = .Cells(Rows.Count, "a").End(xlUp).Row
      .Range("d2:d" & PremLigR) = "Feuil1"
      Sheets("Feuil2").Range("a1").CurrentRegion.Copy .Cells(PremLigR + 1, "a")
      DerLigR = .Cells(Rows.Count, "a").End(xlUp).Row
      .Cells(PremLigR + 1, "d").Resize(DerLigR - PremLigR) = "Feuil2"
      .Cells(PremLigR, "a").Resize(DerLigR - PremLigR + 1, 4).RemoveDuplicates Columns:=Array(1), Header:=xlYes
      .Cells(PremLigR + 1, "a").EntireRow.Delete
      DerLigR = .Cells(Rows.Count, "a").End(xlUp).Row
      .Cells(1, "a").Resize(DerLigR, 4).Sort key1:=.Range("a1"), order1:=xlAscending, Header:=xlYes
      .Cells(2, "c").Resize(DerLigR - 1).FormulaR1C1 = "=IF(OR(RC[-2]=R[-1]C[-2],RC[-2]=R[1]C[-2]),NA(),"""")"
      .Cells(2, "c").Resize(DerLigR - 1) = .Cells(2, "c").Resize(DerLigR).Value
      .Cells(1, "a").Resize(DerLigR, 4).Sort key1:=.Range("c1"), order1:=xlAscending, Header:=xlYes
      On Error Resume Next
      Columns("c:c").SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
      Columns("c:c").EntireColumn.Delete
      Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
   End With
   MsgBox Format(Timer - t0, "#,##0.00\ sec")
End Sub