Macro de recherche sur classeurs multiples

Bonjour à tous.

Voici mon problème. J'ai 3 fichiers excel imposants (plus de 300 000 lignes).

Dans un premier fichier j'ai les informations suivantes, concernant la paie mensuelle de salariés sur 1 année :

date de paie / matricule / nom / prénom / salaire / horaire.

Dans le 2ème :

date de paie / matricule / nom / prénom / allègement charges

Et enfin dans le 3ème fichier:

date de paie / matricule / nom / prénom / Heures sup.

Ce que j'aimerai, c'est combiner ces informations pour n'avoir qu'un seul fichier avec :

date de paie / matricule / nom / prénom / salaire / horaire / HS / Allègement.

une recherche v ne fonctionne pas car elle s'arrête sur la première occurence trouvée. Et que ce soit le matricule, le nom ou la date, ils apparaissent plusieurs fois.

Si quelqu'un a une solution...

J'ai mis en PJ des fichiers exemples très allégés.

Par avance, merci

Ben

Bonjour,

En clair, tu voudrais ajouter les colonne HS et Allègement dans ton fichier 1. Pour cela, il faut regarder : la date, le libellé de l'établissement et le matricule. Si ces trois infos coïncident alors on peut placer l'info supplémentaire dans une colonne (à droite).

C'est quelque chose que tu dois faire régulièrement ou que tu fais une fois pour toutes?

Merci pour ta réponse rapide.

Tu as bien saisi mon problème. Pour répondre à ta question, en ce qui concerne ce dossier, c'est à faire une seule fois. Mais je peux très bien me retrouver à nouveau dans cette situation sur un autre dossier.

Excuse la lenteur de ma réponse, mais je n'arrête pas d'avoir des "plantages" avec ma version d'Excel... Grrr!

Alors, quelques explications et mises au point :

1- Travailles avec des copies de tes fichiers, PAS LES ORIGINAUX. Les originaux, tu les sauvegarde en trois exemplaires sur trois ordis différents du tien!

2- Places tes fichiers (les copies hein?) dans le même répertoire que le fichier joint (sissi, en fin de mon message il y a un fichier!)

3- Dans le code, en haut du module, tu verras 6 Constantes déclarées. (Const machin As String = ...). Note entre les guillemets les véritables noms de tes fichiers, et des feuilles concernées pour chaque fichier.

4- J'ai estimé que le fichier fichier1 comportait toutes les données contenues dans les deux autres fichiers, voire plus encore. Si ce n'est pas le cas, il faudrait nous en dire davantage,

5- Les trois classeurs doivent être fermés,

6- Une fois t'être assurée que tout va bien, installe toi dans ton fauteuil et tapotes ALT+F8, Choix "Import_Trois_Fichiers" et OK...

7- Une fois que le code aura planté, note le message d'erreur, clic sur Débogage et reviens nous donner la ligne de code surlignée de jaune et le message d'erreur... Ou pas!

Le code :

Option Explicit

'!!!!!!!!!!! ¤¤¤¤¤¤¤¤¤¤¤¤ A ADAPTER : les noms des fichiers et des feuilles ¤¤¤¤¤¤¤¤¤ !!!!!!!!!!!!!

Const Fichier1 As String = "fichier 1.xlsx" 'ici le fichier de "base"
Const Fichier2 As String = "fichier 2-1.xlsx" 'ici le fichier qui contient la colonne "Allègement"
Const Fichier3 As String = "fichier 3-1.xlsx" 'ici le fichier qui contient les colonnes "Heures Supp"
Const NomFeuil_1 As String = "Feuil1" 'feuille du fichier de base
Const NomFeuil_2 As String = "Feuil1" 'feuille du fichier2
Const NomFeuil_3 As String = "Feuil1" 'feuille du fichier3

Sub Import_Trois_Fichiers()
Dim Wbk_Sourc As Workbook
Dim Tb_In_Fich1(), Tb_In_Fich2(), Tb_In_Fich3(), Tb_Out()
Dim DLig As Long, L As Long, Lig As Long, Col As Integer, T As Single
Dim Chemin As String

'IMPORTANT :
    'J'ai estimé que le fichier fichier1 comportait toutes les données
    'contenues dans les deux autres fichiers, voire plus encore.
    'Si ce n'est pas le cas, il faudrait nous en dire davantage.

T = Timer
Chemin = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 1 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier1)
With Wbk_Sourc
    With .Sheets(NomFeuil_1)
        DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
        Tb_In_Fich1 = .Range("A2:G" & DLig).Value
    End With
    .Close
End With
Tb_Out = Tb_In_Fich1
ReDim Preserve Tb_Out(1 To UBound(Tb_In_Fich1, 1), 1 To UBound(Tb_In_Fich1, 2) + 7)
Erase Tb_In_Fich1

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 2 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ Colonne "URSAFF Allègement"
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier2)
With Wbk_Sourc
    With .Sheets(NomFeuil_2)
        DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
        Tb_In_Fich2 = .Range("A2:F" & DLig).Value
    End With
    .Close
End With
For L = 1 To UBound(Tb_Out, 1)
    For Lig = 1 To UBound(Tb_In_Fich2, 1)
        'Si les trois premières colonnes sont identiques
        If Tb_In_Fich2(Lig, 1) = Tb_Out(L, 1) And Tb_In_Fich2(Lig, 2) = Tb_Out(L, 2) And Tb_In_Fich2(Lig, 3) = Tb_Out(L, 3) Then
            Tb_Out(L, 8) = Tb_In_Fich2(Lig, 6): Exit For
        End If
    Next Lig
Next L
Erase Tb_In_Fich2

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ IMPORT FICHIER 3 ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ Colonnes "Heures Supp"
Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier3)
With Wbk_Sourc
    With .Sheets(NomFeuil_3)
        DLig = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
        Tb_In_Fich3 = .Range("A2:K" & DLig).Value
    End With
    .Close
End With
For L = 1 To UBound(Tb_Out, 1)
    For Lig = 1 To UBound(Tb_In_Fich3, 1)
        'Si les trois premières colonnes sont identiques
        If Tb_In_Fich3(Lig, 1) = Tb_Out(L, 1) And Tb_In_Fich3(Lig, 2) = Tb_Out(L, 2) And Tb_In_Fich3(Lig, 3) = Tb_Out(L, 3) Then
            For Col = 1 To 6
                Tb_Out(L, 8 + Col) = Tb_In_Fich3(Lig, 5 + Col)
            Next Col
            Exit For
        End If
    Next Lig
Next L
Erase Tb_In_Fich3

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ RESTITUTION DES DONNEES ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Range("A2").Resize(UBound(Tb_Out, 1), UBound(Tb_Out, 2)) = Tb_Out
Application.ScreenUpdating = True
MsgBox "Travail terminé en : " & Timer - T & " secondes."
End Sub

Et le fichier exemple :

Voilà.

Merci de revenir nous communiquer la durée d'exécution de cette macro. En effet, il est toujours utile de savoir comment réagir face à des classeurs de + de 100 000 lignes...

Re!

Bon, le plantage a été rapide puisqu'il me dit que le fichier1 (que j'ai renommé base) est introuvable --> erreur d'execution 1004. J'ai pris soin bien sur de modifier les noms dans le code et de mettre tous les fichiers dans le même répertoire.

Voilà la ligne de code surlignée :

Set Wbk_Sourc = Workbooks.Open(Chemin & Fichier1)

Tu as bien 4 fichiers dans ce répertoire?

Ils sont nommés base.xlsx ? etc?

Il faut changer les noms dans le code que je t'ai donné pour que cela fonctionne.

Les lignes à adapter sont les premières :

Const Fichier1 As String = "fichier 1.xlsx" 'ici le fichier de "base"
Const Fichier2 As String = "fichier 2-1.xlsx" 'ici le fichier qui contient la colonne "Allègement"
Const Fichier3 As String = "fichier 3-1.xlsx" 'ici le fichier qui contient les colonnes "Heures Supp"
Const NomFeuil_1 As String = "Feuil1" 'feuille du fichier de base
Const NomFeuil_2 As String = "Feuil1" 'feuille du fichier2
Const NomFeuil_3 As String = "Feuil1" 'feuille du fichier3

Dans ces lignes de code, change les noms fichier 1.xlsx, fichier 2-1.xlsx, fichier 3-1.xlsx, "Feuil1", "Feuil1", "Feuil1" par leur véritable noms...

oui tout les noms ont été changé dans le code.

As tu enregistré le fichier que je t'ai envoyé?

Fais juste cette macro de test :

Option Explicit

Const Fichier1 As String = "fichier 1.xlsx" 'ici le fichier de "base"
Const Fichier2 As String = "fichier 2-1.xlsx" 'ici le fichier qui contient la colonne "Allègement"
Const Fichier3 As String = "fichier 3-1.xlsx" 'ici le fichier qui contient les colonnes "Heures Supp"
Const NomFeuil_1 As String = "Feuil1" 'feuille du fichier de base
Const NomFeuil_2 As String = "Feuil1" 'feuille du fichier2
Const NomFeuil_3 As String = "Feuil1" 'feuille du fichier3

Sub Test()
Chemin = ThisWorkbook.Path & "\"
MsgBox Chemin & Fichier1 & vbcrlf & Chemin & Fichier2 & vbcrlf & Chemin & Fichier3
End Sub

Tu devrais avoir dans le message le chemin d'accès complet à tes 3 fichiers. Du style C:\Machin\Truc\fichier1.xlsx.

Vérifies qu'ils sont tous ok, y compris les extensions... Attention aux espaces qui pourraient éventuellement se cacher dans un nom de fichier...

j'ai bien enregistré le fichier que tu m'as envoyé. Sinon, lorsque je lance cette macro test, j'ai aussi un message d'erreur :

erreur de compilation : variable non définie.

Pardon...

    Option Explicit

    Const Fichier1 As String = "fichier 1.xlsx" 'ici le fichier de "base"
    Const Fichier2 As String = "fichier 2-1.xlsx" 'ici le fichier qui contient la colonne "Allègement"
    Const Fichier3 As String = "fichier 3-1.xlsx" 'ici le fichier qui contient les colonnes "Heures Supp"
    Const NomFeuil_1 As String = "Feuil1" 'feuille du fichier de base
    Const NomFeuil_2 As String = "Feuil1" 'feuille du fichier2
    Const NomFeuil_3 As String = "Feuil1" 'feuille du fichier3

    Sub Test()
    Dim Chemin As String
    Chemin = ThisWorkbook.Path & "\"
    MsgBox Chemin & Fichier1 & vbcrlf & Chemin & Fichier2 & vbcrlf & Chemin & Fichier3
    End Sub

les chemins d'accès sont les bons, pas de soucis avec les noms ni d'espaces qui viendraient perturber le code...

Je n'y comprends rien...

C'est la partie de la macro qui ne devait pas poser de souci... La simple ouverture d'un classeur...

Essaye de tout fermer, y compris le répertoire et Excel, et de recommencer...

Question subsidiaire : comment lances tu la macro?

J'ai déjà essayé de tout fermer mais rien n'y fait...Je lance la macro en cliquant sur l'onglet développeur puis macros puis exécuter import-trois-fichiers.

On est bien d'accord que les autres fichiers doivent être fermés et qu'ils doivent tous être dans le même répertoire.

Je vais essayer de réenregistrer les fichiers sous un autre nom, à un autre emplacement...

Oui, nous sommes d'accord.

J'en perds mon latin VBA...

Bon...c'est à n'y rien comprendre. J'en perdrais mon latin VBA si je maitrisais ce langage...même en réenregistrant, rien n'y fait toujours le même message d'erreur...

est-ce que le fait d'être sous mac change qqch?

Bonjour,

Je ne sais pas.

On va être vite fixé...

Essaye ceci, stp, et dis moi :

Sources : http://msdn.microsoft.com/fr-fr/library/office/hh710200%28v=office.14%29.aspx#odc_xl4_ta_ProgrammaticallySelectFileforMac_GetOpenFilenameMethodWorkaround

Sub Select_File_Or_Files_Mac()
    Dim MyPath As String
    Dim MyScript As String
    Dim MyFiles As String
    Dim MySplit As Variant
    Dim N As Long
    Dim Fname As String
    Dim mybook As Workbook

    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")
    MyScript = _
    "set applescript's text item delimiters to "","" " & vbNewLine & _
               "set theFiles to (choose file of type " & _
             " {""com.microsoft.Excel.xls""} " & _
               "with prompt ""Please select a file or files"" default location alias """ & _
               MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
               "set applescript's text item delimiters to """" " & vbNewLine & _
               "return theFiles"

    MyFiles = MacScript(MyScript)
    On Error GoTo 0

    If MyFiles <> "" Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        MySplit = Split(MyFiles, ",")
        For N = LBound(MySplit) To UBound(MySplit)

            ' Get the file name only and test to see if it is open.
            Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(MySplit(N))
                On Error GoTo 0

                If Not mybook Is Nothing Then
                    MsgBox "Classeur ouvert : " & MySplit(N)
                    mybook.Close SaveChanges:=False
                End If

        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

Ce code fait ouvrir une fenêtre pour choisir un document. Je t'ai mis une capture d'écran en PJ, ce sera plus parlant.

Oui.

Mais il te faut aller plus loin...

Dans cette fenêtre sélectionne tes trois fichiers et ouvre les...

Si seulement je pouvais...les fichiers sont biens là mais impossible à sélectionner.