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

A
  • Question
XL 2021 Module d’envoi à la Corbeille qui ne fonctionne pas en 64 Bits
2
Réponses
20
Affichages
510
patricktoulon
patricktoulon
L
  • Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
182
lilie17
L
J
  • Question
Combobox - Scroller avec la souris
Réponses
6
Affichages
510
patricktoulon
patricktoulon
B
  • Résolu(e)
Microsoft 365 Problème dans formule VBA
Réponses
7
Affichages
200
BOILEAU
B
Sellig
  • Question
XL 2019 Transférer la valeur d’une formule dans Visual basic
Réponses
8
Affichages
412
job75
job75
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
374
patricktoulon
patricktoulon
N
  • Question
XL 2013 installer un fichier.crx sur chromedriver.exe
Réponses
1
Affichages
264
jurassic pork
jurassic pork
J
  • Résolu(e)
XL 2019 Cercle calcul de distance entre 2 points aux alentours de 0°
Réponses
4
Affichages
169
jclaborde
J
Sellig
  • Question
XL 2019 Ajouter un second filtre DATE en VBA
Réponses
1
Affichages
425
sylvanu
sylvanu
J
  • Question
Microsoft 365 Conversion de fichiers word en pdf / VBA
Réponses
1
Affichages
451
kiki29
kiki29

Membres actuellement en ligne

24 membres et 304 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
315 105
Messages
2 116 265
Membres
112 705
dernier inscrit
kygerlitor