comparer 3 feuilles

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

  • testcomparaisonexemple.xlsx
    37.6 KB · Affichages: 37
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
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
job75

job75

XLDnaute Barbatruc
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
H

homepyrof53

XLDnaute Occasionnel
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
R

romss82

XLDnaute Nouveau
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
R

romss82

XLDnaute Nouveau
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
R

romss82

XLDnaute Nouveau
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
H

homepyrof53

XLDnaute Occasionnel
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
H

homepyrof53

XLDnaute Occasionnel
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
R

romss82

XLDnaute Nouveau
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
job75

job75

XLDnaute Barbatruc
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

  • testcomparaisonexemple(1).xls
    76 KB · Affichages: 31
  • testcomparaisonexemple(1).xlsm
    32.5 KB · Affichages: 28
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
238
chris6999
chris6999
C
  • Question
Microsoft 365 Transposer des valeurs en 2 colonnes en fonction d'une référence produit
Réponses
9
Affichages
346
Cagnet
C
C
  • Question
Microsoft 365 Liste déroulante en colonne 2 en fonction de la colonne 1
Réponses
9
Affichages
432
chris
chris
L
  • Question
Microsoft 365 Comparer 2 TCD en créant un 3 ème
Réponses
4
Affichages
174
lilie91
L
T
  • Résolu(e)
XL 2016 Code vba permettant de faire une recherche soit dans la colonne A ou B
Réponses
8
Affichages
191
telemarrk
T
H
  • Question
XL 2016 fonction FILTRE sur Excel 2016
Réponses
9
Affichages
513
Hynnuh
H
L
  • Question
XL 2010 formule de recherche
Réponses
2
Affichages
402
LOUDC31
L
S
  • Question
Microsoft 365 Excel 365, macros qui disparaissent
Réponses
6
Affichages
263
Simon 1234
S
M
  • Question
XL 2016 afficher uniquement les doublons sur un tableau excel
Réponses
4
Affichages
182
mapomme
mapomme
D
  • Question
Microsoft 365 Complétude fichier
Réponses
8
Affichages
404
DFER
D

Membres actuellement en ligne

15 membres et 101 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 398
Messages
2 088 075
Membres
103 707
dernier inscrit
amin Saadaoui