comparaison entre 2 fichiers VBA

M

MELL90

XLDnaute Nouveau
Bonjour,

Je suis désolé pour le dérangement, je débute en VBA et je réalise mon premier code..

En effet j’ai passé toute la matinée pour chercher comment faire une comparaison entre deux fichiers Excel qui contient des informations différentes sauf le nom et le prénom en commun.

J’ai besoin de faire une comparaison entre les deux fichiers A et B et si je trouve une ligne dans A qui ne se trouve pas dans le fichier B je l’insert dans B..

J’ai trouvé plusieurs lignes de codes sur internet j’ai essayé de l’adapter selon mes besoins mais sans résultat puisque je débute en VBA …et je ne comparant pas trop les lignes de code..

Quelqu’un peut ’aider s’il vous pelait.
 
Trier par date Trier par votes
M

MELL90

XLDnaute Nouveau
bonjour @gosselien
je vous transmets les deux fichiers Excel (les info ne sans pas correct :p juste pour faire le test )
le fichier IC ==> mon fichier A
le fichier piste ==> mon fichier B
je compare A et B ( colonne de comparaison nom,prénom)
si je trouve pas le nom, prénom de mon fichier A dans le fichier B je rajoute les informations en commun (non prénom TU , BM ..) dans mon fichier B.
je pense que c'est un peu difficile puisque les deux fichiers non pas la même structure ..
 

Pièces jointes

  • test_comparaison.zip
    168 bytes · Affichages: 54
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Bonjour

essaie avec ce code à mettre dans un module VBA
VB: 
Sub fusion()
Dim DataSource(), DataDest()
Set FicSource = Workbooks("IC.xlsx")
Set ficDest = Workbooks("Piste.xlsx")

TailleSource = FicSource.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
TailleDest = ficDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

ReDim DataSource(TailleSource, 22)
ReDim DataDest(TailleDest, 16) '= FicDest.Sheets("Sheet1").Range("A2:V" & Range("A" & Rows.Count).End(xlUp).Row).Value

DataSource = FicSource.Sheets("Sheet1").Range("A2:V" & Range("A" & Rows.Count).End(xlUp).Row).Value

For i = LBound(DataSource) To UBound(DataSource) ' nomPrenom In DataSource.Column(5).Value  ' = LBound(DataSource) To UBound(DataSource)
    For j = LBound(DataDest) + 1 To UBound(DataDest)
        If DataDest(j, 3) = DataSource(i, 5) Then
            trouve = True
        End If
    Next j
        If trouve = False Then
            NewTaille = UBound(DataDest) + 1
            ReDim DataDest(NewTaille, 16)
            DataDest(NewTaille, 1) = ""
            DataDest(NewTaille, 2) = DataSource(i, 2)
            DataDest(NewTaille, 3) = DataSource(i, 5)
            DataDest(NewTaille, 4) = DataSource(i, 9)
            DataDest(NewTaille, 5) = DataSource(i, 2)
            DataDest(NewTaille, 6) = DataSource(i, 18)
            DataDest(NewTaille, 7) = DataSource(i, 8)
            DataDest(NewTaille, 8) = DataSource(i, 13)
            DataDest(NewTaille, 9) = ""
            DataDest(NewTaille, 10) = DataSource(i, 4)
            DataDest(NewTaille, 11) = DataSource(i, 3)
            DataDest(NewTaille, 12) = DataSource(i, 17)
            DataDest(NewTaille, 13) = ""
            DataDest(NewTaille, 14) = ""
            DataDest(NewTaille, 15) = ""
            DataDest(NewTaille, 16) = "" 
        End If

Next i

For i = LBound(DataDest) To UBound(DataDest)
    For j = 1 To 16
        ficDest.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, j - 1) = DataDest(i, j)
    Next j
Next i
End Sub
 
Vote positif 0 Vote négatif
M

MELL90

XLDnaute Nouveau
@vgendron

Un grand merci pour votre retour ,

j'ai essayé le code mais j'ai le message d'erreur suivant:
"erreur d'exécution 9, l'indice n'appartient pas à la sélection"
la ligne d'erreur :
ficDest.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, j - 1) = DataDest(i, j)

merci pour votre aide .
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
oui.. pardon..
j'aurais du préciser.
les deux fichiers doivent etre ouverts
il faut modifier le code pour que les noms de fichier correspondent -->IC.xlsx qui a été renommé IC.xlsm (pour fichier avec macro)
ainsi que les noms de feuilles: je travaillais avec une feuille test Sheet2--> il faut donc repasser avec Sheet1
ce qui donne
VB: 
Sub fusion()
Dim DataSource(), DataDest()
Set FicSource = Workbooks("IC.xlsm")
Set ficDest = Workbooks("Piste.xlsx")

TailleSource = FicSource.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
TailleDest = ficDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

ReDim DataSource(TailleSource, 22)
ReDim DataDest(TailleDest, 16) '= FicDest.Sheets("Sheet1").Range("A2:V" & Range("A" & Rows.Count).End(xlUp).Row).Value

DataSource = FicSource.Sheets("Sheet1").Range("A2:V" & Range("A" & Rows.Count).End(xlUp).Row).Value

For i = LBound(DataSource) To UBound(DataSource) ' nomPrenom In DataSource.Column(5).Value  ' = LBound(DataSource) To UBound(DataSource)
    For j = LBound(DataDest) + 1 To UBound(DataDest)
        If DataDest(j, 3) = DataSource(i, 5) Then
            trouve = True
        End If
    Next j
        If trouve = False Then
            NewTaille = UBound(DataDest) + 1
            ReDim DataDest(NewTaille, 16)
            DataDest(NewTaille, 1) = ""
            DataDest(NewTaille, 2) = DataSource(i, 2)
            DataDest(NewTaille, 3) = DataSource(i, 5)
            DataDest(NewTaille, 4) = DataSource(i, 9)
            DataDest(NewTaille, 5) = DataSource(i, 2)
            DataDest(NewTaille, 6) = DataSource(i, 18)
            DataDest(NewTaille, 7) = DataSource(i, 8)
            DataDest(NewTaille, 8) = DataSource(i, 13)
            DataDest(NewTaille, 9) = ""
            DataDest(NewTaille, 10) = DataSource(i, 4)
            DataDest(NewTaille, 11) = DataSource(i, 3)
            DataDest(NewTaille, 12) = DataSource(i, 17)
            DataDest(NewTaille, 13) = ""
            DataDest(NewTaille, 14) = ""
            DataDest(NewTaille, 15) = ""
            DataDest(NewTaille, 16) = ""
        End If
Next i

For i = LBound(DataDest) To UBound(DataDest)
    For j = 1 To 16
        ficDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, j - 1) = DataDest(i, j)
    Next j
Next i
End Sub
à mettre dans un module dans le fichier IC.xlsm
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
et si. il y a un interet à avoir plus de 1 ligne..
ca permet de tester les boucles qui commencent à 1 ou 0..
dans une boucle. c'est presque toujours la première (ou dernière) itération qui bug..
donc la. je ne saurais pas te dire si, dans le cas de plusieurs lignes, ca fonctionne bien pour le tablo entier
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Avec ceci. ca devrait aller mieux..
VB: 
Sub fusion()
Dim DataSource(), DataDest()
Set FicSource = Workbooks("IC.xlsm")
Set FicDest = Workbooks("Piste.xlsx")

TailleSource = FicSource.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
TailleDest = FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Dim ListToCopy(1, 16) 'ligne à recopier

ReDim DataSource(TailleSource + 1, 22) 'contient la ligne d'entete
ReDim DataDest(TailleDest, 16) 'Contient la ligne à copier

DataSource = FicSource.Sheets("Sheet1").Range("A1:V" & TailleSource).Value
DataDest = FicDest.Sheets("Sheet1").Range("A1:P" & TailleDest).Value

For i = LBound(DataSource) + 1 To UBound(DataSource)
    For j = LBound(DataDest) + 1 To UBound(DataDest)
        If DataDest(j, 3) = DataSource(2, 5) Then 'on cherche le Nom Prénom
            trouve = True
        End If
    Next j
        If trouve = False Then 'si on a pas trouvé - on récupère les données de la ligne
            'NewTaille = UBound(DataDest) + 1
            'ReDim DataDest(NewTaille, 16)
            ListToCopy(1, 1) = "-" 'BU 'on met un - pour éviter d'écraser la dernière ligne au fur et à mesure
            ListToCopy(1, 2) = DataSource(i, 2) 'TU
            ListToCopy(1, 3) = DataSource(i, 5) 'Nom Prénom
            ListToCopy(1, 4) = DataSource(i, 9) 'Métier
            ListToCopy(1, 5) = DataSource(i, 2) 'TU
            ListToCopy(1, 6) = DataSource(i, 18) 'Date Dispo
            ListToCopy(1, 7) = DataSource(i, 8) 'DC OK
            ListToCopy(1, 8) = DataSource(i, 13) 'PPT OK
            ListToCopy(1, 9) = DataSource(i, 20) 'Salaire
            ListToCopy(1, 10) = DataSource(i, 4) 'BM
            ListToCopy(1, 11) = DataSource(i, 3) 'TM
            ListToCopy(1, 12) = DataSource(i, 17) 'Client
            ListToCopy(1, 13) = "" 'BM/TM
            ListToCopy(1, 14) = "" 'Date Dernier Statut
            ListToCopy(1, 15) = "" 'Etat
            ListToCopy(1, 16) = "" 'Action complémentaire
           
            FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = ListToCopy(1, 1)
            For k = 2 To 16
                    FicDest.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(0, k - 1) = ListToCopy(1, k)
            Next k
        End If
Next i
End Sub

Tu disais quoi sur l'utilité de plusieurs lignes?? :-D
 
Vote positif 0 Vote négatif
M

MELL90

XLDnaute Nouveau
le nouveau code marche parfaitement juste je dois l'appliquer sur mes fichiers sources avec quelque modification ...
J'ai pas compris ta demande concernant la ligne je suis désolé :( si tu peux m'expliquer ...
par contre je sais pas si tu parles lors de l'ajout d' une ligne dans le fichier IC en temps réelle, dans ce cas je rencontre un problème ..
la mise à jour ne s'effectue pas directement je dois supprimer la totalité des lignes et exécuter le code .
 
Vote positif 0 Vote négatif
M

MELL90

XLDnaute Nouveau
@vgendron Bonjour,
j’espère que ne vous dérange pas ... j'ai testé le code sur mes fichiers d'origine , il fonctionne bien mais il me reste le problème de la mise à jour, lorsque je rajoute une ligne ou je supprime une ligne de fichier IC rien ne change dans mon fichier piste . je dois à chaque fois effacer les enceignent lignes rajoutées .
merci pour votre aide .
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
Combobox - Scroller avec la souris
Réponses
6
Affichages
146
patricktoulon
patricktoulon
Sellig
  • Question
XL 2019 Ajouter un second filtre DATE en VBA
Réponses
1
Affichages
220
sylvanu
sylvanu
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
174
kiki29
kiki29
L
  • Question
XL 2021 VBA Comparaison 2 fichiers
Réponses
8
Affichages
371
l.et.lilou
L
D
  • Question
Microsoft 365 De l’aide pour simplifier ma formule
Réponses
1
Affichages
226
degards
D
S
  • Question
XL 2016 Comparaison de valeur entre 2 colonnes + affichage du résultat trouvé
Réponses
8
Affichages
522
sgomez7
S
S
  • Question
XL 2019 Zoom sur image dans un USF
Réponses
2
Affichages
430
Sheldor
S
S
  • Question
Microsoft 365 Problème chrono dans un fichier excel lorsque 2 fichiers sont ouverts
2
Réponses
15
Affichages
403
steph67
S
J
  • Résolu(e)
XL 2019 Vérifier si 2 cellules ont un mot en commun
Réponses
3
Affichages
676
mapomme
mapomme
L
  • Question
Microsoft 365 Comparer le texte de deux colonnes (plusieurs mots/cellule) pour trouver 1 mot en commun
2 3
Réponses
37
Affichages
2 K
Staple1600
Staple1600

Membres actuellement en ligne

7 membres et 114 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 165
Messages
2 085 883
Membres
103 014
dernier inscrit
moimoi31