Macro dictionnaire pour les doublons

Bonjour ,

Avec votre aide , nous avions créé une macro me permettant de copier les lignes filtrés sur un autre onglet , en prenant en compte une "Clé" pour éviter les doublons.

Cependant ce matin à l'actualisation 2 lignes ne se copie pas . Pouvez-vous m'orienter /m'aider vers le problème ? svp

en essayant la macro filtre fonctionne correctement , je pense donc que ces bien cette macro qui pose problème

ci-joint la macro du transfert de données + fichier test

Sub Transfert_LLS_Suivi()
  Dim Dlig As Long, Lig As Long, nLig As Long
  Dim ShtS As Worksheet, ShtD As Worksheet
  Dim Dico As Object, sKey As String

  ' Définir les feuilles
  Set ShtS = ThisWorkbook.Sheets("LLS")
  Set ShtD = ThisWorkbook.Sheets("SUIVI")
  ' Dernière ligne remplie de la feuille source
  Dlig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Nouvelles ligne de la feuille de destination
  nLig = ShtD.Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Row
  ' Définir le dictionnaire pour les doublons et le remplir
  Set Dico = CreateObject("Scripting.Dictionary")
  With ShtD
    For Lig = 2 To nLig - 1
    sKey = .Range("I" & Lig).Value
    Dico(sKey) = ""
    Next Lig
  End With
  With ShtS
    For Lig = 2 To Dlig
      If .Rows(Lig).Hidden = False Then
      sKey = .Range("P" & Lig).Value
        ' Si clé n'existe pas
        If Not Dico.Exists(sKey) Then
          ' L'ajouter
          Dico.Add sKey, ""
          ' Copier les données
          ShtD.Range("B" & nLig).Value = ShtS.Range("A" & Lig).Value
          ShtD.Range("C" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("J" & Lig).Value

          ' Incrémenter les nouvelle lignes
          nLig = nLig + 1
        End If
      End If
    Next Lig
  End With
  Set ShtD = Nothing: Set ShtS = Nothing

   'message box de confirmation
  MsgBox "Transfert OK !", vbInformation, "Terminée !"

End Sub

Merci d'avance pour votre aide

Bonne journée

Bonjour fleurmi,

Quand savez-vous que 2 lignes ne ce sont pas copiées

A+

Bonjour BrunoM45

On ma demander de faire le suivi de la ref ATA 100 : 25-22-48 révision 5 , et je ne le voyais pas dans l'onglet Suivi ,

cependant il est bien présent dans l'onglet LLS

La clé est donc différentes des autres

Re,

Je ne comprends pas la ligne

sKey = .Range("P" & Lig).Value

Sachant qu'à ce moment là, tu es dans la feuille "LLS", skey ne contient rien !?

Pour moi le code est archi faux

A+

Re,

Effectivement j'ai modifiée le code . Comme tu me l'avait écrit la première fois, je ne c'est pas pourquoi il a été modifié ....

sKey = .Range("P" & Lig).Value => CORRECTION => sKey = .Range("N" & Lig).Value.

Mais la il me copie 2 fois les info dans mon Onglet Suivi , .... je ne comprend plus ... :(

Ce qui est étonnant , dans l'exemple qu'on avait essayer cela fonctionner mais il y avait peu de ligne .

je cherche je cherche mais pas facile

Est-ce possible que du principe ou je n'avait pas appliqué la bonne cle (colonne N) il me comparer a de mauvaise donner ?

Re,

Dans le fichier, ce code

  With ShtD
    For Lig = 2 To nLig - 1
    sKey = .Range("I" & Lig).Value
    Dico(sKey) = ""
    Next Lig
  End With

Créé un dictionnaire sans doublon des dates de dernier retour colonne "I"

Est-ce déjà normal ?

A+

Re ,

Je n'arrive pas a traduire ce code par moi même , mais au vue de tes explications .

le seul dictionnaire des doublons est dans mon onglet LLS colonne N nommée Verif

le but étant ; j'actualise mes données sur l'onglet LLS puis il me transfert les données filtrés sur l'onglet Suivi , en ne copiant pas les doublons du LLS déjà copier d'une précédente actualisation .

Pense tu qu'il faut que j'ai la même colonne verif d'un onglet comme de l'autre ?

je test cette possibilité :)

Re,

Une colonne Verif, pas nécessaire à mes yeux, faut juste que je comprenne ta façon de procéder

Comment sais-tu que ce ne sont pas des doublons ?
Qu'est-ce que tu compares manuellement ?

A+

Re,

Oki Merci, j'ai essayer de le faire mais j'ai tout casé lol effectivement si tu a mieux a me proposer , je suis preneuse

Se ne sont pas des doublon sur l' onglet LLS car 1 ligne = 1 Référence à traiter

je compare pour cela ; REF ATA +REVISION DOC + DESIGNATION+CLIENT+PN => colonne N du l'onglet LLS c'est ce qui me sert comme clé d'identification unique

merci d'avance

Re,

Ok, on avance je regarde ça tout à l'heure chez moi

A+

Re ,

Merci encore , et encore ,idem je viens de rentrée a mon domicile je retente des essais ^^

Re,

Je viens de testée ce code en rajoutant l'idée d'avoir la même clé de l'onglet LLS vers SUIVI, et ça fonctionne !! mais cela me fait modifier l'ensemble des autres macro car je décale d'1 colonne :/ . Mais je suis contente de moi .

Bien sur je reste persuadée que tu va trouver mieux

Sub Transfert_LLS_Suivi()
  Dim Dlig As Long, Lig As Long, nLig As Long
  Dim ShtS As Worksheet, ShtD As Worksheet
  Dim Dico As Object, sKey As String
  ' Définir les feuilles
  Set ShtS = ThisWorkbook.Sheets("LLS")
  Set ShtD = ThisWorkbook.Sheets("SUIVI")
  ' Dernière ligne remplie de la feuille source
  Dlig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Nouvelles ligne de la feuille de destination
  nLig = ShtD.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
  ' Définir le dictionnaire pour les doublons et le remplir
  Set Dico = CreateObject("Scripting.Dictionary")
  With ShtD
    For Lig = 2 To nLig - 1
    sKey = .Range("O" & Lig).Value
    Dico(sKey) = ""
    Next Lig
  End With
  With ShtS
    For Lig = 2 To Dlig
      If .Rows(Lig).Hidden = False Then
      sKey = .Range("N" & Lig).Value
        ' Si clé n'existe pas
        If Not Dico.Exists(sKey) Then
          ' L'ajouter
          Dico.Add sKey, ""
          ' Copier les données
          ShtD.Range("B" & nLig).Value = ShtS.Range("A" & Lig).Value
          ShtD.Range("C" & nLig).Value = ShtS.Range("C" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("H" & nLig).Value = ShtS.Range("J" & Lig).Value

          ' Incrémenter les nouvelle lignes
          nLig = nLig + 1
        End If
      End If
    Next Lig
  End With
  Set ShtD = Nothing: Set ShtS = Nothing

   'message box de confirmation
  MsgBox "Transfert OK !", vbInformation, "Terminée !"

End Sub

mdr , j'ai chercher toute l'aprèm au boulot et arrivée a la maison ça mes venu toute seul....

Bonsoir,

Tu peux être fière de toi, bravo

C'est souvent comme ça quand on cherche, on tourne en rond...
une petite pose, un changement d'endroit et hop l'éclair de génie est là

Pourquoi décales-tu tes colonnes !?

Tu avais ça avant

' Copier les données
          ShtD.Range("C" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("J" & Lig).Value

Et tu as ça maintenant

 ' Copier les données
          ShtD.Range("C" & nLig).Value = ShtS.Range("C" & Lig).Value
          ShtD.Range("D" & nLig).Value = ShtS.Range("B" & Lig).Value
          ShtD.Range("E" & nLig).Value = ShtS.Range("D" & Lig).Value
          ShtD.Range("F" & nLig).Value = ShtS.Range("E" & Lig).Value
          ShtD.Range("G" & nLig).Value = ShtS.Range("I" & Lig).Value
          ShtD.Range("H" & nLig).Value = ShtS.Range("J" & Lig).Value

A+

Bonsoir,

Merci, beaucoup ! Oui , tout ça sa reste grâce a vos compétences qu'on enrichie les nôtres.

je laisse le fichier final

Oui cela impacte la macro archive et priorité que j'ai modifié aussi . j'ai rajouter une colonne pour la désignation , ce qui ma permis de faire la même colonne Vérif d'un onglet a l'autre

Pour moi cela répond a mes besoin , a voir dans le temps avec les utilisateurs finales

Pour peaufiné tout ça , je recherche a faire un complément dans mon message box. qui me permettrai de savoir le nombre de lignes transférer , aurait-tu un conseil ?

Merci encore

Bonne soirée a vous