Code vba comparer F1 et F2 et copier/coller en F2

Regueiro

XLDnaute Impliqué
Bonsoir le Forum
Dans mon code ci-dessous que j'ai repris sur le site de Boisgontier.
Je compare entre les 2 feuilles et copie dans la feuille2
J'aimerais l'adapter pour copier/coller les données sur 3 colonnes.
Mais je bloque.
Code:
Sub MajTph()
Set f1 = Sheets("0.Récap")
Set f2 = Sheets("0.Prix Unitaires")
Set d1 = CreateObject("Scripting.Dictionary")
For Each C In f2.[E8:G36]
    If C.Text <> "" Then
        d1(C.Text) = ""
    End If
Next C
Set d2 = CreateObject("Scripting.Dictionary")
For Each C In f1.[E8:G36]
    If C.Text <> "" Then
        If Not d1.exists(C.Text) Then
            d2(C.Text) = ""
        End If
    End If
Next C
If d2.Count > 0 Then
    f2.[E8].End(xlUp).Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.Keys) 'Ok marche mais transpose
 End If
End Sub
Merci de votre Aide.
A+
 

JNP

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonsoir Regueiro :),
Sans fichier, sans définition de variable, et sans savoir pourquoi tu parles de 3 colonnes en résultat, pas facile de savoir de quoi tu causes :mad:...
A tout hasard, en se basant sur le seul commentaire de la macro :rolleyes:...
Code:
f2.[A8].End(xlUp).Offset(1).Resize(1, d2.Count) = Application.Transpose(Application.Transpose(d2.Keys))
Bonne suite :cool:
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour,
@JNP :
Sans fichier, sans définition de variable, et sans savoir pourquoi tu parles de 3 colonnes en résultat, pas facile de savoir de quoi tu causes ...
Ben oui, c'est pour cela que je n'ai rien proposé.
@Regueiro : au lieu de faire une relance, place donc un fichier exemple (au bout de 245 messages à ton actif, tu devrais connaître les Us et coutumes de ce forum).
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonsoir Le Forum
Bonsoir JNP Merci pour ton Code
Bonsoir David84, Merci pour tes remarques:mad:
Voici le lien pour mon fichier :
http://cjoint.com/?0HxvPyWDTh1

Petites instructions
Aller dans 0.Récap bouton vert copies les données de E8:G36
dans 0.Prix Unitaires, dans celui-ci j'ai un code qui me trie les données.
Ainsi dans cet Onglet je peux gérer mes prix unitaires dans la colonne H.
Ceux-ci sont automatiquement mis à jour dans les onglets ART...

J'ai donc essayé le code de JNP.
Il me copier les données en ligne cette fois ?
La copie doit se faire comme la présentation sur la feuille 0.Récap.

Merci de votre Aide.
Pour info je voulais gérer mes prix unitaires dans la Feuille 0.Récap.
Mais impossible car j'ai une formule matricielle.
Voici le lien au sujet de cette discussion.
https://www.excel-downloads.com/threads/tri-dynamique-impossible-avec-une-matrice.188362/
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
j'ai tenté d'ouvrir ton fichier mais comme je suis en version 64 bits d'excel 2010, cela plante à cause de l'emploi des API et des contrôles que tu utilises (sûrement des Listviews).
Le plus simple au lieu de poster ton fichier de travail sur un site extérieur : poste un petit fichier exemple sur le forum avec uniquement la macro qui pose problème quelques données de départ et le résultat attendu noté manuellement.
Sinon, attends que quelqu'un qui dispose d'une autre version te vienne en aide.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
J'avoue ne pas trop comprendre à quoi cette macro te sert...es-tu sûr que ce soit le code adéquat ?
Pourquoi est-il placé dans un module de feuille et non dans un module classique ?
Quel est le but recherché ?
Tu utilises un dictionnaire pour ne garder que les valeurs uniques présents dans la feuille 0.prix unitaire alors que celle-ci n'a qu'une ligne dans l'exemple fourni...je ne vois pas l'intérêt a priori de tout ceci.
Reprenons par le commencement :
- que veux-tu faire au juste ?
- note manuellement les résultats attendus pour que l'on puisse comprendre en expliquant pas à pas ce que tu cherches à obtenir.
A+
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

J'aimerais copier les données de la feuille 0.Récap de E8:G36 uniquement
dans la feuille 0. Prix unitaires. Cette me sert de BDD.
Il se peut que j'ai une ou plusieurs données dans cette feuille.
Alors si je rajoute des nouvelles données dans F1 il contrôle si ces données sont déjà dans F2.
Si elle n'existe pas, on copie les données en F2.
Voilà le but de cette macro, je crois ?
Merci.
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
Voilà le but de cette macro, je crois ?
Non, pas telle qu'elle est rédigée.
Regarde plutôt ici sur le site de JB (notamment la partie Ajouts dans Base2/Base1).
Je te repose une question à laquelle tu n'as pas répondu : pourquoi as-tu placé ce code dans un module de feuille ?
Sur ce, bonne nuit.
 

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonjour le Forum
Salut David84
Merci pour ton lien sur le Site de JB.
Je vais voir si quelque chose correspont à mon souhait.
J'ais mis ce module dans un module de feuille, Réponse Oui.
Pourquoi, je ne sais pas ?
Quelle différence il y a de le mettre dans un module classique ?
Pour mon information, la Formule de JNP marche, mais elle copie toutes les données sur la même.
J'aimerais modifer le code pour les copier comme sur la F1
Merci
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Bonsoir,
Un petit Up.
Merci de votre Aide
Je préfère aider le demandeur à faire par lui-même plutôt que de lui servir une réponse toute faite qui ne lui rapportera rien d'autre qu'une satisfaction immédiate d'avoir une solution à laquelle il ne comprendra rien et qu'il ne pourra donc pas adapter si besoin.

As-tu tenté d'adapter l'une des propositions placées sur le site de JB ?

Si oui laquelle ? Où bloques-tu ?

J'ai cependant conscience que la manipulation des dictionnaires n'est pas toujours évidente donc si je vois que tu galères, je te proposerai une solution mais dis-moi d'abord ce que tu as essayé de faire par toi-même pour voir ce que tu n'as pas compris.

Concernant l'histoire du module, seuls les codes évènementiels (ceux qui se déclenchent suite à un évènement dans la feuille du type modification du contenu d'une cellule, modification de la sélection d'une cellule, de l'activation ou la désactivation de la feuille, etc.) doivent être placés dans un module de feuille.

Là, ta macro est déclenchée par le clic sur un bouton donc ton code doit être placé dans un module classique.
Si par contre tu veux le déclencher lors de l'activation de l'onglet 0.Prix unitaire, alors là tu devras le mettre dans le module de cette feuille.
A+
 
Dernière édition:

Regueiro

XLDnaute Impliqué
Re : Code vba comparer F1 et F2 et copier/coller en F2

Salut David
Merci pour tes explications sur les modules.
En effet j'ai regarder sur le site JB mais je ne mens sorts pas actuellement.
Je fais une tentative avec ce code, une procédure événementielle dans la Feuil 0.Récap
Code :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Not Intersect(Target, Range("E8:G36")) Is Nothing Then
            Sheets("0.Récap").Select
            Range("E8:G36").Select
            Selection.Copy

            Worksheets("0.Prix Unitaires").Select
            derligne = Range("E8").End(xlDown).Row + 1
            Cells(derligne, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Worksheets("O.Récap").Range("E8:G8").Copy , Cells(.Rows.Count, "E").End(xlUp)(2)
    End If
End Sub
Mais rien ne fonctionne ?
Merci
A+
 

david84

XLDnaute Barbatruc
Re : Code vba comparer F1 et F2 et copier/coller en F2

Re
pars plutôt de ce code de JB et essaie de l'adapter à ton besoin :
Code:
Ajouts dans Base2/Base1

Sub BD2_BD1()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BASE 1")
  Set f2 = Sheets("BASE 2")
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For I = 2 To UBound(a)
    mondico1(a(I, 1)) = ""
  Next I
  ligne = 1
  Dim c
  ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
  For I = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(I, K): Next K
    If Not mondico1.Exists(b(I, 1)) Then
      For K = 1 To UBound(b, 2): c(ligne, K) = b(I, K): Next K
      c(ligne, K) = I
      ligne = ligne + 1
    End If
  Next
  Sheets("BD2 NON BD1").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c
End Sub
A+
 

Discussions similaires

Réponses
1
Affichages
160

Statistiques des forums

Discussions
312 107
Messages
2 085 360
Membres
102 874
dernier inscrit
Petro2611