comparer 3 feuilles

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion romss82
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

romss82

XLDnaute Nouveau
bonjour à tous,

étant plus que novice voir même inculte dans les macro VBA, je vous sollicite afin de me donner un petit coup de main.
je vous expose mon problème.
j'ai un fichier avec 3 feuilles que je souhaite comparer les une avec les autres.

dans la feuille GEDIX j'ai une référence en colonne A que je souhaite comparer avec la colonne A du fichier mecano et avec la colonne J du fichier KARDEX.

ce que je souhaiterai c'est que en Feuil3 je puisse avoir les références identique je m'explique
si la référence en colonne A du fichier gedix est commune au 2 autres fichiers alors on copie la ligne complète du fichier gedix en feuil3


puis en feuil4 n'avoir que les références présente dans le fichier gedix et mecano

et enfin en feuil5 n'avoir que les référence du fichier mecano que l'on ne trouve ni dans le fichier kardex ni dans le fichier gedix


j'espère qu'une âme charitable pourra me dépatouiller de tout ça

je vous joint un fichier exemple
 

Pièces jointes

Trier par date Trier par votes
Re : comparer 3 feuilles

Bonjour romss82,

Le plus simple est d'utiliser le filtre avancé avec l'option "Copier vers un autre emplacement".

Vous mettrez un filtrage dans chacune des feuilles gedix, mecano, kardex.

Les critères seront des formules utilisant bien sûr des fonctions NB.SI.

Nombreux exemples sur le forum, cherchez un peu.

A+
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

Re,

Si vous voulez avancer dans vos connaissances, apprenez à vous servir du filtre avancé.

Je vous ai dit de faire des recherches sur ce forum.

Il vous faudra un peu de temps, c'est normal, soyez patient.

A+
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

Bonjour,

Bien entendu il faut un minimum, voici une base par macro
Code: 
Sub lecture()
' lecture des référence
Dim tab_kardex
Set tab_kardex = CreateObject("scripting.dictionary")
Dim tab_mecano
Set tab_mecano = CreateObject("scripting.dictionary")
Dim tab_gedix
Set tab_gedix = CreateObject("scripting.dictionary")
'-------------------------------------------------------------------
With Sheets("kardex")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_kardex(UCase(Trim(.Cells(l, 10)))) = 1
    Next
End With
'-------------------------------------------------------------------
With Sheets("mecano")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_mecano(UCase(Trim(.Cells(l, 1)))) = 1
    Next
End With
'-------------------------------------------------------------------
With Sheets("gedix")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_gedix(UCase(Trim(.Cells(l, 1)))) = 1
    Next
End With
'-------------------------------------------------------------------
'   present dans kardex mecano gedix (feuille 3)
'-------------------------------------------------------------------
For Each cle In tab_kardex
    If tab_mecano.exists(cle) And tab_gedix.exists(cle) Then
        MsgBox "Present dans les 3 : " & cle
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 4)
'-------------------------------------------------------------------
For Each cle In tab_gedix
    If tab_mecano.exists(cle) Then
        MsgBox "Present dans gedix et mecano : " & cle
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 5)
'-------------------------------------------------------------------
For Each cle In tab_mecano
    If tab_kardex.exists(cle) = False And tab_gedix.exists(cle) = False Then
        MsgBox "Present dans mecano mais pas dans les 2 autres : " & cle
    End If
Next

End Sub
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

merci homepyrof53

c'est exactement ce que je souhaites
par contre au lieu de m'afficher un message à chaque fois j'aimerais que la ligne en question soit copié dans une autre feuille

donc pour la comparaison "present dans kardex mecano gedix" j'aimerais que les resultat soit copier dans la feuil3

pour "present dans mecano gedix" copier dans (feuille 4)


et pour finir "present dans mecano gedix" copier dans (feuille 5)


merci encore pour votre aide
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

merci homepyrof53

c'est exactement ce que je souhaites
par contre au lieu de m'afficher un message à chaque fois j'aimerais que la ligne en question soit copié dans une autre feuille

donc pour la comparaison "present dans kardex mecano gedix" j'aimerais que les resultat soit copier dans la feuil3

pour "present dans mecano gedix" copier dans (feuille 4)


et pour finir "present dans mecano gedix" copier dans (feuille 5)


merci encore pour votre aide
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

j'ai essayé de modifié le code

voir ci-dessous mais ca ne fonctionne pas

j'ai juste besoins d'un dernier petit coups de main

Sub lecture()
' lecture des référence
Dim tab_kardex
Set tab_kardex = CreateObject("scripting.dictionary")
Dim tab_mecano
Set tab_mecano = CreateObject("scripting.dictionary")
Dim tab_gedix
Set tab_gedix = CreateObject("scripting.dictionary")
'-------------------------------------------------------------------
With Sheets("kardex")
row_min = .UsedRange.Row
row_max = row_min + .UsedRange.Rows.Count - 1
For l = 2 To row_max
tab_kardex(UCase(Trim(.Cells(l, 10)))) = 1
Next
End With
'-------------------------------------------------------------------
With Sheets("mecano")
row_min = .UsedRange.Row
row_max = row_min + .UsedRange.Rows.Count - 1
For l = 2 To row_max
tab_mecano(UCase(Trim(.Cells(l, 1)))) = 1
Next
End With
'-------------------------------------------------------------------
With Sheets("gedix")
row_min = .UsedRange.Row
row_max = row_min + .UsedRange.Rows.Count - 1
For l = 2 To row_max
tab_gedix(UCase(Trim(.Cells(l, 1)))) = 1
Next
End With
'-------------------------------------------------------------------
' present dans kardex mecano gedix (feuille 3)
'-------------------------------------------------------------------
For Each cle In tab_kardex
If tab_mecano.exists(cle) And tab_gedix.exists(cle) Then
cle.EntireRow.Copy
Worksheets("Feuil3").Range("A1").Select
Selection.Insert Shift:=xlDown

End If
Next
'-------------------------------------------------------------------
' present dans mecano gedix (feuille 4)
'-------------------------------------------------------------------
For Each cle In tab_gedix
If tab_mecano.exists(cle) Then
cle.EntireRow.Copy
Worksheets("Feuil4").Range("A1").Select
Selection.Insert Shift:=xlDown
End If
Next
'-------------------------------------------------------------------
' present dans mecano gedix (feuille 5)
'-------------------------------------------------------------------
For Each cle In tab_mecano
If tab_kardex.exists(cle) = False And tab_gedix.exists(cle) = False Then
cle.EntireRow.Copy
Worksheets("Feuil5").Range("A1").Select
Selection.Insert Shift:=xlDown
End If
Next

End Sub
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

Bonsoir,

J'ai ecrit le code uniquement pour la feuille 3 je te laisse faire pour les autres (il suffit de copier)

Code: 
Sub lecture()
' lecture des références
Dim tab_kardex
Set tab_kardex = CreateObject("scripting.dictionary")
Dim tab_mecano
Set tab_mecano = CreateObject("scripting.dictionary")
Dim tab_gedix
Set tab_gedix = CreateObject("scripting.dictionary")
'-------------------------------------------------------------------
With Sheets("kardex")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_kardex(UCase(Trim(.Cells(l, 10)))) =[COLOR=#ff0000][U][B] l[/B][/U][/COLOR]
    Next
End With
'-------------------------------------------------------------------
With Sheets("mecano")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_mecano(UCase(Trim(.Cells(l, 1)))) =[COLOR=#ff0000][B][U] l[/U][/B][/COLOR]
    Next
End With
'-------------------------------------------------------------------
With Sheets("gedix")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_gedix(UCase(Trim(.Cells(l, 1)))) =[U][B][COLOR=#ff0000] l[/COLOR][/B][/U]
    Next
End With
'-------------------------------------------------------------------
'   present dans kardex mecano gedix (feuille 3)
'    recopie gedix en feuille3
'-------------------------------------------------------------------
[COLOR=#ff0000]l2 = 2: ' ligne de départ dans feuille "[/COLOR]
For Each cle In tab_kardex
    If tab_mecano.exists(cle) And tab_gedix.exists(cle) Then
        l1 = tab_gedix(cle) ' recupère la ligne dans gedix
[COLOR=#ff0000]        For b = 1 To 4 ' nombre de colonne dans gedix
            Sheets("Feuil3").Cells(l2, b) = Sheets("gedix").Cells(l1, b)
        Next
        l2 = l2 + 1[/COLOR]
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 4)
'-------------------------------------------------------------------
For Each cle In tab_gedix
    If tab_mecano.exists(cle) Then
        MsgBox "Present dans gedix et mecano : " & cle
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 5)
'-------------------------------------------------------------------
For Each cle In tab_mecano
    If tab_kardex.exists(cle) = False And tab_gedix.exists(cle) = False Then
        MsgBox "Present dans mecano mais pas dans les 2 autres : " & cle
    End If
Next
End Sub

Bonne soirée
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

Je te renvoie le code car j'avais mis les modifications en rouge mais ceci ajoute des codes


Code: 
Sub lecture()
' lecture des références
Dim tab_kardex
Set tab_kardex = CreateObject("scripting.dictionary")
Dim tab_mecano
Set tab_mecano = CreateObject("scripting.dictionary")
Dim tab_gedix
Set tab_gedix = CreateObject("scripting.dictionary")
'-------------------------------------------------------------------
With Sheets("kardex")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_kardex(UCase(Trim(.Cells(l, 10)))) = l
    Next
End With
'-------------------------------------------------------------------
With Sheets("mecano")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_mecano(UCase(Trim(.Cells(l, 1)))) = l
    Next
End With
'-------------------------------------------------------------------
With Sheets("gedix")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_gedix(UCase(Trim(.Cells(l, 1)))) = l
    Next
End With
'-------------------------------------------------------------------
'   present dans kardex mecano gedix (feuille 3)
'    recopie gedix en feuille3
'-------------------------------------------------------------------
l2 = 2: ' ligne de départ dans feuille "
For Each cle In tab_kardex
    If tab_mecano.exists(cle) And tab_gedix.exists(cle) Then
        l1 = tab_gedix(cle) ' recupère la ligne dans gedix
        For b = 1 To 4 ' nombre de colonne dans gedix
            Sheets("Feuil3").Cells(l2, b) = Sheets("gedix").Cells(l1, b)
        Next
        l2 = l2 + 1
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 4)
'-------------------------------------------------------------------
For Each cle In tab_gedix
    If tab_mecano.exists(cle) Then
        MsgBox "Present dans gedix et mecano : " & cle
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 5)
'-------------------------------------------------------------------
For Each cle In tab_mecano
    If tab_kardex.exists(cle) = False And tab_gedix.exists(cle) = False Then
        MsgBox "Present dans mecano mais pas dans les 2 autres : " & cle
    End If
Next
End Sub
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

homepyrof53 à dit:
Bonsoir,

J'ai ecrit le code uniquement pour la feuille 3 je te laisse faire pour les autres (il suffit de copier)

Code: 
Sub lecture()
' lecture des références
Dim tab_kardex
Set tab_kardex = CreateObject("scripting.dictionary")
Dim tab_mecano
Set tab_mecano = CreateObject("scripting.dictionary")
Dim tab_gedix
Set tab_gedix = CreateObject("scripting.dictionary")
'-------------------------------------------------------------------
With Sheets("kardex")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_kardex(UCase(Trim(.Cells(l, 10)))) =[COLOR=#ff0000][U][B] l[/B][/U][/COLOR]
    Next
End With
'-------------------------------------------------------------------
With Sheets("mecano")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_mecano(UCase(Trim(.Cells(l, 1)))) =[COLOR=#ff0000][B][U] l[/U][/B][/COLOR]
    Next
End With
'-------------------------------------------------------------------
With Sheets("gedix")
    row_min = .UsedRange.Row
    row_max = row_min + .UsedRange.Rows.Count - 1
    For l = 2 To row_max
        tab_gedix(UCase(Trim(.Cells(l, 1)))) =[U][B][COLOR=#ff0000] l[/COLOR][/B][/U]
    Next
End With
'-------------------------------------------------------------------
'   present dans kardex mecano gedix (feuille 3)
'    recopie gedix en feuille3
'-------------------------------------------------------------------
[COLOR=#ff0000]l2 = 2: ' ligne de départ dans feuille "[/COLOR]
For Each cle In tab_kardex
    If tab_mecano.exists(cle) And tab_gedix.exists(cle) Then
        l1 = tab_gedix(cle) ' recupère la ligne dans gedix
[COLOR=#ff0000]        For b = 1 To 4 ' nombre de colonne dans gedix
            Sheets("Feuil3").Cells(l2, b) = Sheets("gedix").Cells(l1, b)
        Next
        l2 = l2 + 1[/COLOR]
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 4)
'-------------------------------------------------------------------
For Each cle In tab_gedix
    If tab_mecano.exists(cle) Then
        MsgBox "Present dans gedix et mecano : " & cle
    End If
Next
'-------------------------------------------------------------------
'   present dans mecano gedix (feuille 5)
'-------------------------------------------------------------------
For Each cle In tab_mecano
    If tab_kardex.exists(cle) = False And tab_gedix.exists(cle) = False Then
        MsgBox "Present dans mecano mais pas dans les 2 autres : " & cle
    End If
Next
End Sub

Bonne soirée
Cliquez pour agrandir...

il me marque une erreur sur la ligne tab_kardex(UCase(Trim(.Cells(l, 10)))) = l

avez vous une idée du Pb car je sèche!
 
Vote positif 0 Vote négatif
Re : comparer 3 feuilles

Bonjour romss82, homepyrof53,

Juste pour montrer comment on applique le filtre avancé, le code dans ThisWorkbook du fichier joint :

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range
Select Case Sh.Name
  Case "Filtre 1"
    Set P = Sheets("gedix").[A:D]
    P.Parent.[J2] = "=COUNTIF(kardex!J:J,A2)*COUNTIF(mecano!A:A,A2)"
  Case "Filtre 2"
    Set P = Sheets("gedix").[A:D]
    P.Parent.[J2] = "=COUNTIF(mecano!A:A,A2)"
  Case "Filtre 3"
    Set P = Sheets("mecano").[A:I]
    P.Parent.[J2] = "=NOT(COUNTIF(kardex!J:J,A2)+COUNTIF(gedix!A:A,A2))"
  Case Else: Exit Sub
End Select
P.AdvancedFilter xlFilterInPlace, P.Parent.[J1:J2] 'filtre avancé
Intersect(P, P.Parent.UsedRange.EntireRow).Copy Sh.[A2]
Sh.Rows(Sh.UsedRange.Rows.Count + 1 & ":" & Sh.Rows.Count).Delete
Sh.Rows("2:" & Sh.Rows.Count).Columns.AutoFit 'ajustement de la largeur
P.AdvancedFilter xlFilterInPlace, "" 'RAZ
P.Parent.[J2] = ""
End Sub
Les feuilles "Filtre" se mettent à jour quand on les active.

Ce n'est quand même pas la mer à boire.

Edit : je joins les 2 fichiers .xls et .xlsm.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Gexk5
  • Résolu(e)
Microsoft 365 Double liste déroulante
Réponses
10
Affichages
340
fanch55
fanch55
S
  • Résolu(e)
Microsoft 365 Afficher la référence de colonne d'un entête
Réponses
3
Affichages
180
Cousinhub
Cousinhub
P
  • Résolu(e)
Microsoft 365 Macro Excel pour effectuer des opérations sur les lignes et cellules adjacentes
2
Réponses
19
Affichages
386
Perceval973
P
E
  • Résolu(e)
Microsoft 365 Fonction Si - Ne renvoie pas à la bonne référence
2
Réponses
22
Affichages
547
eoliv
E
R
  • Résolu(e)
XL 2019 recherche dans plage
Réponses
10
Affichages
412
AtTheOne
AtTheOne
G
  • Résolu(e)
Microsoft 365 Trouver et calculer écarts ventes provenant de 2 systèmes
2 3
Réponses
35
Affichages
775
AtTheOne
AtTheOne
D
  • Résolu(e)
Microsoft 365 Assistance pour optimisation d'un code VBA qui ne fonctionne pas comme souhaité
2
Réponses
21
Affichages
487
desto
D
M
  • Résolu(e)
Microsoft 365 Erreur 9 macro
Réponses
3
Affichages
193
matmac
M
cecilette
  • Question Question
Microsoft 365 Insertion de photo
Réponses
14
Affichages
449
AtTheOne
AtTheOne
MLGARIN
  • Question Question
Microsoft 365 Associer une variable à une couleur dans des graphiques excel à plusieurs feuilles
Réponses
13
Affichages
486
Hecatonchire
H
H
  • Question Question
XL 2021 Formule "recherchex"
Réponses
6
Affichages
130
h.harn
H
papacorno
  • Question Question
XL 2016 comparaison de deux feuilles excel
Réponses
2
Affichages
462
papacorno
papacorno
C
  • Question Question
XL 2021 Mettre en couleur cellule avec une mêmes informations
Réponses
3
Affichages
119
Ckyara31
C
F
  • Question Question
XL 2016 tableaux xl
Réponses
12
Affichages
225
TooFatBoy
TooFatBoy
luno123
  • Question Question
Microsoft 365 créer des feuilles automatiques et une formule avec condition de remplissage
Réponses
2
Affichages
266
luno123
luno123
E
  • Résolu(e)
Autres série de feuilles à incrémenter dans un tableau
Réponses
9
Affichages
138
Etienne
E
D
  • Question Question
XL 2021 Boucle sur deux feuilles
Réponses
11
Affichages
182
dadaze
D
Robyalex
  • Résolu(e)
XL 2021 tableau de données
Réponses
9
Affichages
232
AtTheOne
AtTheOne
Xav33820
  • Question Question
XL 2021 Saisies multiples
Réponses
4
Affichages
152
job75
job75
S
  • Question Question
Microsoft 365 Consolider des données de plusieurs feuilles
Réponses
2
Affichages
236
Sissou71
S
Retour