Comparer 2 fichiers et mettre à jour un fichier par rapport à l'autre

[Pleyel]

Bonjour,

Je me permets de vous solliciter car je suis débutant en programmation VBA et je ne sais pas comment optimiser le code d'une macro que j'ai "bricolé" pour mon travail.

En effet, je dois comparer 2 fichiers entre eux et mettre à jour l'un des fichiers par rapport à l'autre. Le premier fichier est le fichier de référence qui contient les informations de référence à jour. Le deuxième fichier est un fichier de travail, qui permet de suivre d'autres informations liées aux données de référence du premier fichier.

J'ai donc réalisé (comme j'ai pu) une macro qui va, à l'ouverture du fichier de travail, réaliser les actions suivantes :

- Recherche les lignes qui n'existe plus dans le fichier de référence et les colorent en rouge (la comparaison se fait par rapport à la colonne 3 et 4 des fichiers ci-joint)

- Met à jour les données de référence pour les lignes qui sont présentes dans les 2 fichiers (pour éviter que la modification d'une information contenue dans une colonne non testée du fichier de référence ne soit pas mise à jour dans le fichier de travail)

- Recherche les lignes qui ont été rajoutées dans le fichier de référence, copie ces lignes, les rajoutent dans le fichier de travail et les colorent en vert.

- Affiche un message qui indique le nombre de lignes qui ont été supprimées et le nombre de lignes qui ont été ajoutées.

Cette macro fonctionne mais le problème c'est qu'elle prend beaucoup trop de temps à s'exécuter (elle doit s'exécuter à chaque ouverture du fichier de travail!!).
Étant novice en VBA j'ai très probablement du alourdir inutilement ma macro, pourriez vous m'aider à optimiser cette macro pour qu'elle puisse s'exécuter dans un temps qui reste raisonnable ? (de l'ordre de 10 secondes)

Vous trouverez ci-joint les 2 fichiers citées plus haut : le fichier de référence "Copie de Liste alphabétique des sites vtest1.xls" et le fichier de travail "Listes installations test1.xls". Le nombre de ligne du fichier de référence à été volontairement tronqué pour une question de taille. Du coup, le délai d'exécution de la macro paraît correct alors qu'en réalité lorsque le fichier contient le nombre de lignes réel (environ 1700 lignes), le délai est beaucoup plus long!!

Merci d'avance pour l'aide que vous pourrez m'apporter.

Cordialement,

PS : pour la bonne exécution de la macro, il faut modifier le chemin du fichier de référence " Chemin_fichier_réf =".

 

[Hippolite]

Re : Comparer 2 fichiers et mettre à jour un fichier par rapport à l'autre

Bonjour,
J'ai fait un esssai en supprimant les Activate, mais le gain n'est pas significatif.

Sub Maj_installations()
'Désactive la vision à l'écran des différentes étapes de la macro
    Application.ScreenUpdating = False
    'Ouvre le fichier avec la liste d'installations de référence
    Chemin_fichier_réf = ThisWorkbook.Path & "\Copie de Liste alphabétique des sites vtest1.xls"
    Workbooks.Open Filename:=Chemin_fichier_réf
    'Initialisation des variable
    Nom_fichier_ref = "Copie de Liste alphabétique des sites vtest1.xls"
    Nom_fichier_maj = "Listes installations test1.xls"
    Nom_onglet_ref = "Liste installations"
    Nom_onglet_maj = "Liste installations"
    Prem_ligne_ref = 3
    Prem_ligne_maj = 3
    Colonne_installation_ref = 3
    Colonne_nomInstallation_ref = 4
    Colonne_installation_maj = 3
    Colonne_nomInstallation_maj = 4
    i = 0
    j = 0
    Compteur = 0
    Compteur_perdues = 0
    Compteur_nouvelles = 0
    'Recherche la dernière ligne de la liste d'installations à mettre à jour
    Workbooks(Nom_fichier_maj).Activate
    Dern_ligne_maj = Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Range("C65536").End(xlUp).Row
    'Recherche la dernière ligne de la liste d'installations de référence
    Dern_ligne_ref = Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Range("C65536").End(xlUp).Row
    ' Boucle identification installations perdues et MaJ des informations de référence
    For X = Prem_ligne_maj To Dern_ligne_maj
        For Y = Prem_ligne_ref To Dern_ligne_ref
            'Comparaison des 2 fichiers par rapport au n° d'installation
            If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_installation_maj).Value = _
               Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_installation_ref).Value Then
                'Comparaison de contrôle par rapport au nom de l'installation
                If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(X, Colonne_nomInstallation_maj).Value = _
                   Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(Y, Colonne_nomInstallation_ref).Value Then
                    Compteur = i + 1
                    ' MaJ de toutes les informations pour les installations présentes dans les 2 fichiers
                    With Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref)    '.Activate
                        .Range(.Cells(Y, 1), .Cells(Y, 27)).Copy
                    End With
                    With Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj)    '.Activate
                        .Range(.Cells(X, 1), .Cells(X, 27)).PasteSpecial Paste:=xlPasteValues, _
                                                                         Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    End With
                End If
            Else
            End If
        Next Y
        If Compteur = 0 Then
            If Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex <> 3 Then
                Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(X).Interior.ColorIndex = 46
                'Compte les installations supprimées depuis la dernière ouverture du fichier
                Compteur_perdues = Compteur_perdues + 1
            End If
        Else
            Compteur = 0
        End If
        '        End If
    Next X
    ' Boucle rajout et indentification installations nouvelles
    i = 0
    For X = Prem_ligne_ref To Dern_ligne_ref
        For Y = Prem_ligne_maj To Dern_ligne_maj
            'Comparaison des 2 fichiers par rapport au n° d'installation
            If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_installation_ref).Value = _
               Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_installation_maj).Value Then
                'Comparaison de contrôle par rapport au nom de l'installation
                If Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref).Cells(X, Colonne_nomInstallation_ref).Value = _
                   Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Cells(Y, Colonne_nomInstallation_maj).Value Then
                    Compteur = i + 1
                    'Compteur = 1 si l'installation est présente dans les 2 fichiers et 0 sinon
                End If
            Else
            End If
        Next Y
        'La nouvelle installation est copiée dans le fichier à mettre à jour
        If Compteur = 0 Then
            Dern_ligne_maj = Dern_ligne_maj + 1
            With Workbooks(Nom_fichier_ref).Sheets(Nom_onglet_ref)    '.Activate
                .Range(.Cells(X, 1), .Cells(X, 27)).Copy
            End With
            With Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj)    '.Activate
                .Range(.Cells(Dern_ligne_maj, 1), .Cells(Dern_ligne_maj, 27)).PasteSpecial _
                        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
            'Colore en vert la dernière ligne ajouté
            Workbooks(Nom_fichier_maj).Sheets(Nom_onglet_maj).Rows(Dern_ligne_maj).Interior.ColorIndex = 43
            'Compte les installations nouvelles depuis la dernière ouverture du fichier
            Compteur_nouvelles = Compteur_nouvelles + 1
        Else
            Compteur = 0
        End If
    Next X
    'Fermeture du fichier avec les installations de référence
    Workbooks(Nom_fichier_ref).Close
    ' Message pour indiquer le nombre d'installations nouvelles et le nombre d'installations supprimées
    MsgBox ("Il y a " & Compteur_nouvelles & " installation(s) nouvelle(s) et " & _
            Compteur_perdues & " installation(s) supprimée(s) depuis votre dernière visite.")
End Sub

Pour gagner du temps d'exécution, il faudrait travailler avec des objets Dictionnary auxquels on accède par des clés au lieu d'indices.
Exemples ici : boisgontierjacques.free.fr/Objet dictionary
A+

 

[Pleyel]

Re : Comparer 2 fichiers et mettre à jour un fichier par rapport à l'autre

Bonjour Hippolite,

J'ai regardé le lien que tu m'as envoyé plus particulièrement la partie sur la comparaison de classeur.

Par contre je n'arrive à l'appliquer concretement à ma macro...Pourrais tu me donner un coup de main.

Merci d'avance.