Afficher uniquement les nouvelles entrées

[kev1]

Bonjour,

J'aimerais avoir un tableau me permettant de comparer deux bases de données (dans deux onglets différents) et m'indiquer les valeurs qui ne sont pas des doublons. Cela me permettrait de voir rapidement les nouvelles données. J'ai mis en pièce jointe un exemple avec seulement quelques données (nous devrions avoir comme résultat: Angleterre et Pays Bas)

Merci de votre aide et une bonne année à tous

 

[phlaurent55]

Re : Afficher uniquement les nouvelles entrées

Bonjour kev,

ton fichier en retour (avec utilisation d'une MFC)

à+
Philippe

 

[kev1]

Re : Afficher uniquement les nouvelles entrées

Merci Philippe

Je recherche plutôt une formule me permettant de me donner directement le résultat car les bases de données que j'utilise font plus de 50000 lignes

 

[phlaurent55]

Re : Afficher uniquement les nouvelles entrées

Re,

à toi de tester sur le fichier réel, il suffit de bien cibler la zone nommée "Pays1" dans la 1ère feuille

à+
Philippe

 

[laetitia90]

Re : Afficher uniquement les nouvelles entrées

bonjour tous
peut être par macro
en tenant en compte que la premiere colonne B comme occurence

Sub es()
  Dim t(), t1(), t2(), i As Long, m As Object, c As Byte, x
  Application.ScreenUpdating = 0
  Set m = CreateObject("Scripting.Dictionary")
  t2 = Feuil1.Range("b3:b" & Feuil1.Cells(Rows.Count, 2).End(3).Row)
  t = Feuil2.Range("b3:d" & Feuil2.Cells(Rows.Count, 2).End(3).Row)
  For i = 1 To UBound(t2): m(t2(i, 1)) = "":  Next i
   ReDim t1(1 To UBound(t), 1 To 3)
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1)) Then
  x = x + 1
  For c = 1 To 3: t1(x, c) = t(i, c): Next c
  End If
  Next i
  Feuil3.[b3].Resize(x, 3) = t1
  Erase t, t1, t2: Set m = Nothing
End Sub

en prenant en compte les 3 colonnes

Sub est()
Dim t(), t1(), t2(), i As Long, m As Object, c As Byte, x
  Application.ScreenUpdating = 0
  Set m = CreateObject("Scripting.Dictionary")
  t2 = Feuil1.Range("b3:d" & Feuil1.Cells(Rows.Count, 2).End(3).Row)
  t = Feuil2.Range("b3:d" & Feuil2.Cells(Rows.Count, 2).End(3).Row)
  For i = 1 To UBound(t2)
   m(t2(i, 1) & t2(i, 2) & t2(i, 3)) = ""
  Next i
   ReDim t1(1 To UBound(t), 1 To 3)
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1) & t(i, 2) & t(i, 3)) Then
  x = x + 1
  For c = 1 To 3: t1(x, c) = t(i, c): Next c
  End If
  Next i
  Feuil3.[b3].Resize(x, 3) = t1
  Erase t, t1, t2: Set m = Nothing
End Sub

 

[klin89]

Re : Afficher uniquement les nouvelles entrées

Bonsoir le forum
Pas mieux

Sub Essai()
Dim a, b(), txt As String, i As Long, n As Long, x, y, e
    Application.ScreenUpdating = False
    a = Sheets("Feuil1").Range("B2").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            txt = a(i, 1)
            'txt = Join$(Array(a(i, 1), a(i, 2), a(i, 3)))
            .Item(txt) = Array(a(i, 1), a(i, 2), a(i, 3))
        Next
        a = Sheets("Feuil2").Range("B2").CurrentRegion.Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = 2 To UBound(a, 1)
            txt = a(i, 1)
            'txt = Join$(Array(a(i, 1), a(i, 2), a(i, 3)))
            If .exists(txt) Then
                .Item(txt) = Empty
            Else
                n = n + 1
                b(n, 1) = a(i, 1)
                b(n, 2) = a(i, 2)
                b(n, 3) = a(i, 3)
                .Item(txt) = Empty
            End If
        Next
        For Each e In .keys
            If IsEmpty(.Item(e)) Then .Remove e
        Next
        'x = .Count: y = .items
    End With
    If n > 0 Then
        With Sheets("Feuil3").Cells(1)
            .CurrentRegion.Clear
            .Resize(, 3).Value = [{"Pays","Date","Nuitée"}]
            .Offset(1).Resize(n, 3).Value = b
            With .CurrentRegion
                With .Rows(1)
                    .Interior.ColorIndex = 44
                    .BorderAround Weight:=xlThin
                End With
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
            .Parent.Select
        End With
    Else
        MsgBox "Aucune donnée trouvée"
    End If
    Application.ScreenUpdating = True
End Sub

klin89