Comparer deux listes et ajouter les manquantes

Bonjour à tous,

Je vous explique la problèmatique :

Je voudrai mettre à jour une liste de données (Feuille "Plan") en la comparant avec la feuille "Buffer" qui est injectée depuis une BDD.

La macro a pour fonction d'ajouter les lignes qui ne sont pas présente dans la feuille "plan" depuis la feuille "Buffer".

J'ai trouvé un topic qui répondait à peu près au besoin.

https://forum.excel-pratique.com/excel/comparer-deux-listes-et-ajouter-la-ligne-manquante-t28240.html

Cepandant quand j'applique le code sur ma feuille rien ne s'ajoute à la feuille "Plan" mais la zone tampon définie par le code est bien incrémentée.

Voici le code en question :

Sub Complète()

Dim lg&, f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    Set f1 = Sheets("Buffer")
    Set f2 = Sheets("Plan")

    f1.Activate
    lg = Application.Max( _
        f1.Cells.Find("*", , , , xlByRows, xlPrevious).Row, _
        f2.Cells.Find("*", , , , xlByRows, xlPrevious).Row)
    '--- filtre les manquants en feuille "Plan" ---
    Range("v2") = "=COUNTIF(Plan!c5:c" & lg & ",c5)=0"     'critère
    Range("a5:j" & lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("v1:v2"), CopyToRange:=Range("k1:t1"), Unique:=False
    '--- Complète ---
    Range("k2:t" & [k65000].End(xlUp).Row + 1) _
    .Copy Destination:=f2.Range("a" & Rows.Count).End(xlUp)(2)
    'Columns("k:v").Clear
    f2.Activate
End Sub

Je n'arrive pas à trouver d'où vient l'erreur (ça doit être un truc tout bête) et j'aurai besoin un peu d'aide

Merci d'avance

le fichier :

Bonsoir,

Tu as dû laisser des morceaux en route...

Autre méthode :

Sub Compléter()
    Dim d As Object, k, np%, nb%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("Buffer")
        nb = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To nb
            d(.Cells(i, 3).Value) = i
        Next i
    End With
    With Worksheets("Plan")
        np = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To np
            If d.exists(.Cells(i, 3).Value) Then d.Remove (.Cells(i, 3).Value)
        Next i
    End With
    With Worksheets("Buffer")
        .Range("K5") = "Temp"
        For Each k In d.keys
            .Range("K" & d(k)) = 1
        Next k
        .Range("A5:K" & nb).AutoFilter 11, 1
        Application.ScreenUpdating = False
        .Range("A6:J" & nb).SpecialCells(xlCellTypeVisible).Copy _
         Worksheets("Plan").Range("A" & np + 1)
        .ShowAllData: .AutoFilterMode = False
        .Range("K5:K" & nb).ClearContents
    End With
End Sub

Salut merci de ta réponse rapide, petite question j'ai parfois l'erreur "la methode AutoFilter de la classe Range à échoué", à quoi cela peut-il correspondre?

Bonjour,

Je ne vois pas ? On filtre sur une colonne qu'on ajoute, si la situation de départ est identique... Le problème pouvant survenir est par contre si aucun élément à ramener sur Plan (facile, il suffit d'actionner une 2e fois la mise à jour), là soit erreur parce que pas de cellule visible dans la plage, soit VBA passe outre et copie l'en-tête (seule visible) malgré la référence de plage...

J'ai eu les deux en vérifiant !

Pour bloquer ça, ajouter une ligne avant le dernier With Worksheets("Buffer") :

    If d.Count = 0 Then Exit Sub
    With Worksheets("Buffer")

Cordialement.

Salut,

ça fonctionne à merveille ! l'erreur sur l'AutoFilter n'a pas l'air de revenir c'était surment du à une mauvaise manip.

Je te remercie MFerrand

Salut,

J'avais une question, Est-ce que tu penses qu'il est possible de supprimer les données dans "Plan" qui ne sont plus présents dans la BDD ("Buffer") ? Je m'explique, la BDD est mise à jour régulièrement, les ordres terminés disparaissent et d'autres sont ajoutés.

Par exemple, dans le fichier joint, j'aimerai que l'ordre 1 soit supprimé de la feuille "Plan" car il ne fait pas parti de la liste dans la feuille "Buffer" tout en ajoutant les lignes de "Buffer" (ordre 7) non présentes dans "Plan".

Merci de ton aide , Cdlt.

Dans ce cas, le résultat est Buffer ! Rccourci : tu susbstitue Buffer à Plan et la mise à jour est faite !

Cordialement.

Salut,

En effet j'avais pas pensé à faire l'opération inverse

a marche bien mais du coup ça me fait beaucoup de ligne et 2sub c'est possible de les imbriquer ?

Sub Compléter()
    Dim d As Object, k, np%, nb%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("Buffer")
        nb = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To nb
            d(.Cells(i, 3).Value) = i
        Next i
    End With
    With Worksheets("Plan")
        np = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To np
            If d.exists(.Cells(i, 3).Value) Then d.Remove (.Cells(i, 3).Value)
        Next i
    End With
     If d.Count = 0 Then
         Worksheets("Buffer").Range("A6:J200").ClearContents
     Exit Sub
     End If
    With Worksheets("Buffer")
        .Range("K5") = "Temp"
        For Each k In d.keys
            .Range("K" & d(k)) = 1
        Next k
        .Range("A5:K" & nb).AutoFilter 11, 1
        Application.ScreenUpdating = False
        .Range("A6:J" & nb).SpecialCells(xlCellTypeVisible).Copy _
         Worksheets("Plan").Range("A" & np + 1)
        .ShowAllData: .AutoFilterMode = False
        .Range("K5:K" & nb).ClearContents
         Worksheets("Buffer").Range("A6:J200").ClearContents
    End With
End Sub

Sub Supprimer()
    Dim d As Object, k, np%, nb%, i%
    Set d = CreateObject("Scripting.Dictionary")
    With Worksheets("Plan")
        nb = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To nb
            d(.Cells(i, 3).Value) = i
        Next i
    End With
    With Worksheets("Buffer")
        np = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 6 To np
            If d.exists(.Cells(i, 3).Value) Then d.Remove (.Cells(i, 3).Value)
        Next i
    End With
     If d.Count = 0 Then
         'Worksheets("Plan").Range("A6:J200").ClearContents
     Exit Sub
     End If
    With Worksheets("Plan")
        .Range("K5") = "Temp"
        For Each k In d.keys
            .Range("K" & d(k)) = 1
        Next k
        .Range("A5:K" & nb).AutoFilter 11, 1
        Application.ScreenUpdating = False
        .Range("A6:J" & nb).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        'Worksheets("Buffer").Range("A" & np + 1)
        .ShowAllData: .AutoFilterMode = False
        .Range("K5:K" & nb).ClearContents
        'Worksheets("Plan").Range("A6:J200").ClearContents
    End With
End Sub

Merci de ton aide

Je ne comprends pas bien ce que tu veux faire !

Si dans Plan on doit ajouter les éléments de Buffer qui n'y sont pas, et supprimer les éléments qui ne sont plus dans Buffer, cela veut dire que la mise à jour est constituée par Buffer en tant que tel, et la procédure se réduit à 3 ou 4 lignes pour efface Plan et mettre Buffer à la place !

Cordialement.

Oui c'est exactement ce que je veux faire

Bonjour,

Encore plus simple :

Sub MiseAJour()
    Worksheets("Plan").Delete
    Worksheets("Buffer").Name = "Plan"
End Sub

Cordialement.