Comparaison de 2 fichiers

Question

Bonsoir,

J'ai besoin d'aide sur VBA (help please !!), je dois comparait 2 fichiers xls contenant tous les deux des données dont un matricule sur la colonne E pour le 1er fichier et la colonne I du second fichier. 
En suite, vérifier pour chaque ligne du fichier 1 (clé = matricule) sont existence dans le fichier 2 (colonne I), en là parsant de haut vert le bas, si valeur existe au moins une fois, prendre la dernière valeur et copier la valeur de la colonne A de cette même ligne dans la colonne A du 1er fichier.

merci d'avance pour votre aide.

Polux31 · Answer

Bonjour,

Quelques questions:

- Il y a t'il un titre dans tes colonnes E du fichier 1 et I du fichier 2 ? 
- Dans quel fichier se trouve la macro que tu veux faire ?
- Qu'est ce qui déclenche la macro ?
 

A+
«Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.» 
Nicolas Boileau

cnw · Answer

Bonjour,

Merci d'avance pour votre aide.

-Les deux colonnes s'appellent Matricule dans les deux fichiers.
-LA Macro doit être sur le fichier principal (fichier 1).
-Le declancheur peut-être à l'ouverture du fichier prencipal ou bien dans une feuille avec un bouton.

Merci encore.

Martin.

Polux31 · Answer

Re

Copier le code ci dessous dans un module et affecter la fonction au déclancheur:

Option Explicit

'-- /!\ NE PAS OUBLIER DE COCHER LA REFERENCE Microsoft ActiveX Data Object xx Library

Public Sub CompareChampMatricule()
Dim Cn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Cd As ADODB.Command
Dim fichier As String
Dim feuille As String
Dim wk As Workbook
Dim ws As Worksheet
Dim ligne As Long
Dim newLigne As Long

'--- Initialisation ---
    Set Cn = New ADODB.Connection
    Set wk = ThisWorkbook
    Set ws = wk.Worksheets("Feuil1")  'A adapter ...
    fichier = "D:\CCM\monFichier2.xlsx"  'A adapter ...
    feuille = "Feuil1"
    ligne = 2
    '------------------
    
    '--- Connexion au fichier source ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
    '-----------------
    
    '--- Traitement -----
    While ws.Range("E" & ligne).Value <> ""
        Set Cd = New ADODB.Command
        Cd.ActiveConnection = Cn
        Set Rst = New ADODB.Recordset
        Cd.CommandText = "SELECT Matricule FROM [" & feuille & "$] WHERE Matricule = '" & ws.Range("E" & ligne).Value & "'"
        Rst.Open Cd, , adOpenKeyset, adLockOptimistic
        Rst.MoveFirst
        If Rst.RecordCount > 0 Then
            Rst.MoveLast
            newLigne = ws.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range("A" & newLigne + 1).CopyFromRecordset Rst
            Set Rst = Nothing
            Set Cd = Nothing
            Query = ""
        End If
        ligne = ligne + 1
    Wend
    '-----------
    
    '--- Libération des objets et de la mémoire
    Set wk = Nothing
    Set ws = Nothing
    Cn.Close
    Set Cn = Nothing
    '-------------------------
    
End Sub
 

;0)
 
«Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.» 
Nicolas Boileau

cnw · Answer

Bonjour,

Merci pour votre aide,

comment faire cette action ? 
'-- /!\ NE PAS OUBLIER DE COCHER LA REFERENCE Microsoft ActiveX Data Object xx Library

Martin

cnw · Answer

Bonjour,

Après des recherches sur le NET j'ai fini par trouvé. 
Au lancement du VBA, j'ai eu une erreur sur une variable non initialisée:

Erreur de compilation : variable non définie :

(ligne Query = "")

Martin

cnw · Answer

Bonjour,

Erreur d'exécution:

-2147217904 (80040e10)
Erreur Automation

je ne comprends rien !!

Martin

cnw · Answer

Bonjour,

Je viens de faire du pas-à-pas et ça bloque à la ligne :

        Rst.MoveFirst

Martin

Polux31 · Answer

Tu as modifié les 2 lignes :

 Set ws = wk.Worksheets("Feuil1")  'A adapter ...
fichier = "D:\CCM\monFichier2.xlsx"  'A adapter ...

Assures toi de l'extension du fichier Excel ...
 
«Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.» 
Nicolas Boileau

cnw · Answer

Bonjour,

Oui j'ai bien changé les valeurs :

    Set ws = wk.Worksheets("Suivi")  'A adapter ...    fichier = "Liste mensuelle des effectifs en 10_13.xlsx"  'A adapter ...    feuille = "Base mensuelle"

Martin

cnw · Answer

Bonjour,

Pouvez-vous l'expliquer les deux lignes suivantes SVP ?

newLigne = ws.Range("A" & Rows.Count).End(xlUp).Row
            ws.Range("A" & newLigne + 1).CopyFromRecordset Rst


Martin

cnw · Answer

Bonjour,

Pour être sûr que mon fichier 2 est bien sélectionné, j'ai modifié la ligne :

fichier = "C:\Users\mmeguellati\Downloads\VBA-natacha\Liste mensuelle des effectifs en 10_13.xlsx"  'A adapter ...

en 

fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")


toujours la même erreur :

-2147217904 (80040e10)
Erreur Automation

Martin

cnw · Answer

l'erreur vient de cette ligne :

  Rst.Open Cd,  ,adOpenKeyset, adLockOptimistic

entre Cd et la seconde virgule j'ai un vide . Est-ce normal ?

Martin

Polux31 · Answer

Tu as cocher quelle référence ?

Et il me faudrait l'entête de la colonne A du fichier 2 !!!

cnw · Answer

Bonjour,

J'essaie de faire une macro qui fait la même chose que le votre mais ça bloque :

Option Explicit

Sub ImporterColonnes()
Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), col As Integer, Resultat As Variant
Dim NWbkColle As Integer, MWbkCopy As Integer, DWbkColle As Integer



  'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
  Set WbkColle = ThisWorkbook
  'A adapter : Nom des entêtes de colonnes à importer
  Colonnes = Array("Matricule")
  
  'Sélection du fichier
  Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
  'En cas de clic sur "ANNULER"
  If Fichier <> False Then
    'On ouvre le fichier en question
    Set WbkCopy = Workbooks.Open(Fichier)
    
    With WbkCopy.Sheets("Base mensuelle") '==> ADAPTER NOM de la feuille
      'Boucle sur toutes les entêtes des colonnes
      For col = 2 To .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column
        'teste si l'entête correspond à un des noms des colonnes à copier
        Resultat = Application.Match(.Cells(2, col), Colonnes, 0)
        'Si l'entête est trouvée (colonne à copier)
        If Not IsError(Resultat) Then
          'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("TRUC" à remplacer)
          '.Columns(Col).Copy WbkColle.Sheets("COLLER").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
          'impression pop-up les colonnes Matricule sont bien là
        
        End If ' si l'entête existe bien
      Next col
            
    'rechercher avec mise-à-jour correspendance valeur
        
    For NWbkColle = 4 To WbkColle.Sheets("Suivi").Range("E65536").End(xlUp).Row
    For MWbkCopy = 4 To WbkCopy.Sheets("Base mensuelle").Range("I65536").End(xlUp).Row
    For DWbkColle = 4 To WbkColle.Sheets("Suivi").Range("M65536").End(xlUp).Row
    
    If InStr(WbkCopy.Sheets("Base mensuelle").Range("I" & MWbkCopy), WbkColle.Sheets("Suivi").Range("E" & NWbkColle)) <> 0 Then
        'Copié - collé
         WbkCopy.Sheets("Base mensuelle").Range("I" & MWbkCopy).Copy WbkColle.Sheets("Suivi").Range("M" & DWbkColle)
    
    End If
   Next NWbkColle
   Next MWbkCopy
   Next DWbkColle
    
    End With
       
    WbkCopy.Close
  End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub

J'ai une erreur de compilation :

référence de validation de contrôle

Comparaison de 2 fichiers

14 réponses

Discussions similaires

Newsletters