Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 VBA Comparaison fichier

Fofi1

XLDnaute Nouveau
Bonjour,



J’aimerai avoir votre retour concernant le code vba pour la comparaison de deux fichier.



J’aimerai que la macro compare le fichier 1 que j’appelle Export avec le fichier Eqt.

Sur le fichier Export j’ai les numéros des équipements sur la colonne B ayant eu une intervention lors de l’année et sur le fichier Eqt j’ai les équipements pour lesquelles je suis le responsable sur la colonne A.



J’aimerai donc que la macro compare les deux fichiers et supprime les lignes du fichier Export pour lesquelles l’équipement ne correspond pas au fichier Eqt.



Pour ce faire j’ai essayé une macro qui réalise l’action sur un même fichier Feuil 1 et Feuil 2 et lorsque je modifie le code pour l’utiliser non plus sur des feuilles mais des fichiers différents Erreur.



Voir ci-dessous :



Code fonctionnement sur deux feuilles du même fichier :


Dim PlgImmat As Range

Dim PlgRecherche As Range

Dim CelImmat As Range

Dim i As Long



'défini la plage en colonne B de la feuille "Feuil1" à partir de B1

With Worksheets ("Feuil1"): Set PlgImmat = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With



'défini la plage en colonne 1 de la feuille "Feuil2" à partir de A1

'(Sur ma feuille 2, j'ai des milliers de lignes d'événements liés à un véhicule, dont l'immatriculation associée est en colonne G.)

With Worksheets ("Feuil1"): Set PlgRecherche = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With



'pour la suppression, commencer par le bas de la plage

For i = PlgRecherche.Count To 1 Step -1


'effectue la recherche exacte...

Set CelImmat = PlgImmat.Find(PlgRecherche(i, 1).Value, , xlValues, xlWhole)

'si pas trouvée, suppression

If CelImmat Is Nothing Then PlgRecherche(i, 1).EntireRow.Delete

Next i

End Sub




Voici le code utilisé pour deux fichier différents :





Sub Suprresion1()



'*****************************************************

Dim CheckFile1 As Boolean, CheckFile2 As Boolean

'*****************************************************

'PERMET D'OUVRIR LE FICHER SOUHAITE DANS LE REPERTOIRE DEFINI

'*****************************************************

Chemin = \partages\SERVEUR

'

'*****************************************************

'ACTIVATION DES VARIABLES

'*****************************************************

Fichier1 = "export_MR*_80.xls"

Fichier2 = "Eqt.xlsx"





Myfile1 = Chemin & Fichier1

Myfile2 = Chemin & Fichier2





Workbooks.Open (Myfile1)



LigDI1Titre = 1 'première ligne à vérifier

dernligneDI1 = Range("A" & Rows.Count).End(xlUp).Row ' nombre total de ligne à contrôler

Workbooks.Open (Myfile2)

LigDI2Titre = 1 'première ligne à vérifier

dernligneDI2 = Range("A" & Rows.Count).End(xlUp).Row ' nombre total de ligne à contrôler

Dim PlgImmat As Range

Dim PlgRecherche As Range

Dim CelImmat As Range

Dim i As Long


With Fichier1("Feuil1"): Set PlgImmat = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

With Fichier2("Feuil1"): Set PlgRecherche = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

'pour la suppression, commencer par le bas de la plage

For i = PlgRecherche.Count To 1 Step -1

'effectue la recherche exacte...

Set CelImmat = PlgImmat.Find(PlgRecherche(i, 1).Value, , xlValues, xlWhole)

'si pas trouvée, suppression

If CelImmat Is Nothing Then PlgRecherche(i, 1).EntireRow.Delete


Next i

End Sub



Pouvez-vous m’indiquer des pistes pour résoudre ce problème.



Merci d’avance
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour à tous, Bonjour @Fofi1

Ton PB vient de ce que Fichier1 et Fichier2 sont des String et nom des Workbook essaie cela :

'________________________________________________________________________________________________________

Sub Suppresion()
'*****************************************************

Dim CheckFile1 As Boolean, CheckFile2 As Boolean
Dim Fichier1 As Worksheet, Fichier2 As Worksheet
Dim NFichier1 As String, NFichier2 As String, Chemin as String, MyFile1 as String, Myfile2 as String

Dim PlgImmat As Range
Dim PlgRecherche As Range
Dim CelImmat As Range
Dim i As Long

'*****************************************************
'PERMET D'OUVRIR LE FICHER SOUHAITE DANS LE REPERTOIRE DEFINI
'*****************************************************

'A VERIFIER : le chemin est-il correct ?
Chemin = "\partages\SERVEUR"

'*****************************************************
'ACTIVATION DES VARIABLES
'*****************************************************
NFichier1 = "export_MR*_80.xls"
Myfile1 = Chemin & Fichier1
NFichier2 = "Eqt.xlsx"
Myfile2 = Chemin & Fichier2

'Fichier1 : Feuille "Feuil1" du classeur ouvert
Set Fichier1 = Workbooks.Open(Myfile1).Worksheets("Feuil1")


LigDI1Titre = 1 'première ligne à vérifier
dernligneDI1 = Range("A" & Rows.Count).End(xlUp).Row ' nombre total de ligne à contrôler
With Fichier1: Set PlgImmat = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

'Fichier2 : Feuille "Feuil1" du classeur ouvert
Set Fichier2 = Workbooks.Open(Myfile2).Worksheets("Feuil1")


LigDI2Titre = 1 'première ligne à vérifier
dernligneDI2 = Range("A" & Rows.Count).End(xlUp).Row ' nombre total de ligne à contrôler
With Fichier2: Set PlgRecherche = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

'pour la suppression, commencer par le bas de la plage
For i = PlgRecherche.Count To 1 Step -1
'effectue la recherche exacte...
Set CelImmat = PlgImmat.Find(PlgRecherche(i, 1).Value, , xlValues, xlWhole)
'si pas trouvée, suppression
If CelImmat Is Nothing Then PlgRecherche(i, 1).EntireRow.Delete
Next i

End Sub
'________________________________________________________________________________________________________

Bien sur tu peux paramétrer le nom de tes fichiers plutôt que de les mettre en dur dans le code (par exemple dans une plage de ton classeur contenant la macro. )

Amicalement
Alain
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
329
Réponses
7
Affichages
591
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…