comparaison entre 2 fichiers VBA

MELL90 · 30 Juin 2017

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.

gosselien · 30 Juin 2017

Bonjour,
"Quelqu’un peut ’aider s’il vous pelait"

La réponse est oui mais le fichier est tellement loin qu'on ne le voit pas

P.

MELL90 · 30 Juin 2017

bonjour @gosselien
je vous transmets les deux fichiers Excel (les info ne sans pas correct 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 ..

bof · 30 Juin 2017

bonjour,
Ton zip est foireux...
A+

MELL90 · 3 Juillet 2017

Bonjour @bof , @gosselien
merci me dire si mon zip est ok

gosselien · 3 Juillet 2017

Re,

tu aurais pu te faire un peu d'exercice aux doigts en mettant 20 à 30 lignes....

Je renonce

P.

MELL90 · 3 Juillet 2017

Bonjour,
je ne trouve pas l'intérêt à mettre 20 lignes ... je pense qu'une seule ligne pas fichier suffit pour faire la comparaison ..
en tout cas je vous remercie pour votre réponse et votre temps .
bonne journée...

vgendron · 3 Juillet 2017

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

MELL90 · 3 Juillet 2017

@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 .

vgendron · 3 Juillet 2017

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

vgendron · 3 Juillet 2017

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

MELL90 · 3 Juillet 2017

Bonjour ,
Un grand merci pour vous, et pour votre explication..

En effet dans mon fichier piste j’ai que la dernière ligne de fichier IC qui se rajoute..

vgendron · 3 Juillet 2017

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

MELL90 · 3 Juillet 2017

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 .

MELL90 · 4 Juillet 2017

@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 .

comparaison entre 2 fichiers VBA

MELL90

XLDnaute Nouveau

gosselien

XLDnaute Barbatruc

MELL90

XLDnaute Nouveau

Pièces jointes

bof

XLDnaute Occasionnel

MELL90

XLDnaute Nouveau

Pièces jointes

gosselien

XLDnaute Barbatruc

MELL90

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

MELL90

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

MELL90

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

MELL90

XLDnaute Nouveau

MELL90

XLDnaute Nouveau

Discussions similaires