Rechercher des fichiers excel dans un dossier

Elephant -  
 Elephant -
Bonjour,

Je suis en train d'essayer d'améliorer mon code. Je ne m'y connais pas bien en vba. Le but mon code est d'ouvrir 12 fichiers , chaque fichier contenant des informations sur un mois de données. Les 12 fichiers sont contenus dans un dossier...et le problème c'est que j'ai 100 dossiers, ayant donc chacuns 12 fichiers excel.
Mon code actuel permet uniquement d'ouvrir manuellement chaque fichier avec un GetOpenFile...ce qui risque d'être trop long a faire sur les 1200 fichiers.
Je souhaiterai pouvoir les ouvrir automatiquement puisqu'on peut les identifier de la sorte (éléments en gras):
2011-01 etc
2011-02 etc
2011-03 etc
Et en fait, les infos du mois de janvier sont répertoriés dans la feuille 1 de mon fichier, celles su mois de février, dans la feuille 2 etc.
Cependant, mon code étant très très long (60 pages)(car je n'arrivais pas à boucler sur des worksheet j'ai fait des copier coller...et je ne voyais pas comment faire une boucle pour changer de worksheet....bref), je l'ai subdivisé en plusieurs 'Private Sub'

J'aimerai savoir comment on peut faire pour qu'on puisse comme manipulation faire que :
1) une fenetre s'ouvre pour aller ouvrir le dossier qui nous intéresse
2) que ça traite les fichiers automatiquement
J'ai essayé ce début de code mais il ne fonctionne pas.... 

Dim chemin As String      
chemin = InputBox("Entrez le nom de votre dossier qui contient les fichiers à analyser exemple : \1 ATL ", "CODE AITA AEROPORT")      
          
     On Error Resume Next      
     monfichier = Application.FileSearch      
     monfichier.LookIn = "C:\Users\Tami\Desktop\Connections at airports\" & chemin      
 MsgBox ("C:\Users\Tami\Desktop\Connections at airports" & chemin)      
     monfichier.Filename = "*.xls"      
              
         
    If monfichier.Execute > 0 Then      
        For x = 1 To monfichier.FoundFiles.Count      
        MsgBox (Mid(monfichier.FoundFiles(x), 6, 2))      
            If Mid(monfichier.FoundFiles(x), 6, 2) = "01" Then      
                  
                Workbooks.Open Filename:=monfichier.FoundFiles(x)      
            End If      
        Next x      
        Else      
             MsgBox ("fichier 01 pas trouvé")      
    End If


Je sais pas comment faire pour joindre mon code en entier en *.zip... alors voila le début de code comment il est à lorigine, et ce que j'aimerai faire c'est donc remplacer tous les GETOPENFILE par l'ouverture automatique 

Private Sub Code()     


Call Janvier     
Call Fevrier     
Call Mars     
Call Avril     
Call Mai     
Call Juin     
Call Juillet     
Call Aout     
Call Septembre     
Call Octobre     
Call Novembre     
Call Decembre     
Call Annee     
Call Saison     


End Sub     



Private Sub Janvier()     

Dim Wb As Workbook     
Dim Ws As Worksheet     
Dim caractere As String     
Dim ligne As Integer     
Dim colonne As Integer     
Dim aa As Variant     
Dim bb As Variant     
Dim departs As Integer     
Dim Code As String     
Dim ref As Variant     
Dim compteur As Integer     
'____________________________________________________________________________________________     
'     
'MOIS DE JANVIER     
'____________________________________________________________________________________________     

'Feuille un du fichier opérations, jour : 1     
'---------------------------------------------     
    MsgBox ("Aller chercher le fichier à analyser intitule : année-01 OAG Connections at aéroport")     
    monfichier = Application.GetOpenFilename()     
         
    'ouvre le fichier Excel     
    Set Wb = Workbooks.Open(monfichier)     

    'ouvre la feuille 1     
    Set Ws = Wb.Worksheets(1)     
         
    Sheets(2).Cells(1, 2) = "Heures de départ"     
    Sheets(2).Cells(1, 3) = "Départs jour 1"     
    Sheets(2).Cells(1, 4) = "Départs jour 2"     
    Sheets(2).Cells(1, 5) = "Départs jour 3"     
    Sheets(2).Cells(1, 6) = "Départs jour 4"     
    Sheets(2).Cells(1, 7) = "Départs jour 5"     
    Sheets(2).Cells(1, 8) = "Départs jour 6"     
    Sheets(2).Cells(1, 9) = "Départs jour 7"     
    Sheets(2).Cells(1, 10) = "Départs par semaine"     
    Sheets(2).Cells(1, 11) = "Départs mois de janvier"     
             
    'lit les données dans le fichier Excel     
    For ligne = 3 To 50     
             
        For colonne = 15 To 24     
            'extraction des heures     
            Sheets(2).Cells(ligne, 2) = Ws.Cells(ligne, 14)     
            If InStr(1, Sheets(2).Cells(ligne, 2).Value, " ") > 0 Then     
            bb = Split(Sheets(2).Cells(ligne, 2).Value, " ")     
            Sheets(2).Cells(ligne, 1) = bb(0)     
            End If     
        Next colonne     
             
    Next ligne     


Set Ws = Wb.Worksheets(1)     
          
            'comptage des avions single aisle     
For ligne = 3 To 50  '3 to 50     
    departs = 0     
    For i = 2 To 23 'pour lire les codes sur les 2 à 23 lignes     
        ' extraction du code     
        Code = Sheets(1).Cells(i, 1).Value     
             
        For colonne = 15 To 24     
                 
            'comptage si on a une cellule qui a un des codes     
            If InStr(1, Wb.Worksheets(1).Cells(ligne, colonne).Value, Code, vbTextCompare) > 0 Then     
            departs = departs + 1     
            End If     

        Next     

        'on va compter combien y'a de code dans la cellule colonne 24 où y'a plein de code avions dans monfichier     
        If InStr(1, Wb.Worksheets(1).Cells(ligne, 25).Value, ",") > 0 Then 'si on a une cellule avec plein de codes avion     
            aa = Split(Wb.Worksheets(1).Cells(ligne, 25).Value, Code)  'on compte combien de fois on a le code     
            'For i = 0 To UBound(aa)     
            departs = UBound(aa) + departs 'occurences avion + compteur     
            Else     
                 
            If InStr(1, Wb.Worksheets(1).Cells(ligne, 25).Value, Code, vbTextCompare) > 0 Then     
            departs = departs + 1     
            End If     
                                 
        End If     
             
        Sheets(2).Cells(ligne, 3).Value = departs     
             
    Next     
                 
Next     


'Feuille un du fichier opérations, jour : 2     
'---------------------------------------------     

Set Ws = Wb.Worksheets(2)     
        
'comptage des avions single aisle     
For ligne = 3 To 50  '3 to 50     
    departs = 0     
    For i = 2 To 23 'pour lire les codes sur les 23 lignes     
        ' extraction du code     
        Code = Sheets(1).Cells(i, 1).Value     
                           
        For colonne = 15 To 24     
                 
            'comptage si on a une cellule qui a un des codes     
            If InStr(1, Wb.Worksheets(2).Cells(ligne, colonne).Value, Code, vbTextCompare) > 0 Then     
            departs = departs + 1     
            End If


ça continue comme ça jusqu'à la worksheet 7 : 

St Ws = Wb.Worksheets(7)     
        
'comptage des avions single aisle     
For ligne = 3 To 50  '3 to 50     
    departs = 0     
    For i = 2 To 23 'pour lire les codes sur les 23 lignes     
        ' extraction du code     
        Code = Sheets(1).Cells(i, 1).Value     
                           
        For colonne = 15 To 24     
                 
            'comptage si on a une cellule qui a un des codes     
            If InStr(1, Wb.Worksheets(7).Cells(ligne, colonne).Value, Code, vbTextCompare) > 0 Then     
            departs = departs + 1     
            End If     

        Next     

        'on va compter combien y'a de code dans la cellule colonne 24 où y'a plein de code avions dans monfichier     
        If InStr(1, Wb.Worksheets(7).Cells(ligne, 25).Value, ",") > 0 Then 'si on a une cellule avec plein de codes avion     
            aa = Split(Wb.Worksheets(7).Cells(ligne, 25).Value, Code)  'on compte combien de fois on a le code     
            'For i = 0 To UBound(aa)     
            departs = UBound(aa) + departs 'occurences avion code + compteur     
            Else     
                 
            If InStr(1, Wb.Worksheets(7).Cells(ligne, 25).Value, Code, vbTextCompare) > 0 Then     
            departs = departs + 1     
            End If     
                                 
        End If     

        Sheets(2).Cells(ligne, 9).Value = departs     
             
    Next     
                  
Next     
                
'*********************     
'*ANALYSE DES DONNEES*     
'*********************     
         
'Addition pour calcul départs par semaine     
'----------------------------------------     
For i = 3 To 50     
    Sheets(2).Cells(i, 10).Clear     
    For j = 3 To 9     
    Sheets(2).Cells(i, 10) = Sheets(2).Cells(i, j) + Sheets(2).Cells(i, 10)     
    Next     
Next     
         
'Addition pour calcul départs par mois     
'en janvier 2011 il y a eu 5 lundi, samedi et dimanche et 4 mardi mercredi jeudi vendredi     
'----------------------------------------------------------------------------------------     
For i = 3 To 50     
Sheets(2).Cells(i, 11) = 5 * Sheets(2).Cells(i, 3) + 4 * Sheets(2).Cells(i, 4) + 4 * Sheets(2).Cells(i, 5) + 4 * Sheets(2).Cells(i, 6) + 4 * Sheets(2).Cells(i, 7) + 5 * Sheets(2).Cells(i, 8) + 5 * Sheets(2).Cells(i, 9)     
Next     

  'ferme le fichier Excel     
    Wb.Close SaveChanges:=False     


End Sub

et ça recommence, le même code pour février mais qui écrit dans une feuille différente du workbook.... 

    
Private Sub Fevrier()     

Dim Wb As Workbook     
Dim Ws As Worksheet     
Dim caractere As String     
Dim ligne As Integer     
Dim colonne As Integer     
Dim aa As Variant     
Dim bb As Variant     
Dim departs As Integer     
Dim Code As String     
Dim ref As Variant     
Dim compteur As Integer     

'____________________________________________________________________________________________     
'     
'MOIS DE FEVRIER     
'____________________________________________________________________________________________     
'     
'Feuille un du fichier opérations, jour : 1     
'---------------------------------------------     

    MsgBox ("Aller chercher le fichier à analyser intitule : année-02 OAG Connections at aéroport")     
    monfichier = Application.GetOpenFilename()     
    'ouvre le fichier Excel     
    Set Wb = Workbooks.Open(monfichier)     
       
    'ouvre la feuille 1     
    Set Ws = Wb.Worksheets(1)     
         
    Sheets(3).Cells(1, 2) = "Heures de départ"     
    Sheets(3).Cells(1, 3) = "Départs jour 1"     
    Sheets(3).Cells(1, 4) = "Départs jour 2"     
    Sheets(3).Cells(1, 5) = "Départs jour 3"     
        Next


Je sais que c'est vachement indigeste :'(
Merci pour toute aide....
A voir également:

1 réponse

Réponse 1 / 1
pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 768
 
Bonjour,
Pour choisir un répertoire et ensuite boucler sur tous les fichiers qu'il contient : 
Option Explicit

Sub BouclerFichierMemeRepertoire()
'sources : https://excel.developpez.com/faq/
Dim oShell As Object
Dim oFolder As Object
Dim oFolderItem As Object
Dim Chemin As String, Fichier As String

Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "c:\")
If oFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical
Else
  Set oFolderItem = oFolder.Self
  Chemin = oFolderItem.Path & "\"
End If
    Fichier = Dir(Chemin & "*.xls")
    'Boucle sur les fichiers
    Do While Len(Fichier) > 0
        'ICI ON PEUX TESTER PAR EXEMPLE LE NOM DU FICHIER
        'AVANT DE L'OUVRIR
        Workbooks.Open Chemin & Fichier
        'blablablabla
        'MsgBox ActiveWorkbook.Name
        ActiveWorkbook.Close
        Fichier = Dir
    Loop
End Sub
1
Elephant
 
Merci beaucoup !!!!!!!!! je crois avoir compris, donc je dois rajouter en dessous de WhileLen le test que j'ai écrit avec MID etc.
Par contre j'ai une question, comment faire pour que ça garde en mémoire le dossier où je suis allée?
Car mon problème est le suivant :
J'ai un programme "principal" qui appelle avec "call" 12 sous programmes (équivalents aux mois de l'année et donc aux 12 différents fichiers). Du coup je dois mettre le code que tu m'as filé, amélioré bien sur, dans le programme principal, pour que ça boucle, car le truc c'est que si je le mets dans tous mes "sous programmes", je vais devoir choisir 12 fois le dossier ce qui revient à la même chose que getopenfile...
En fait j'avais essayé de mettre les Getopenfile dans le fichier principal et après de tester pour voir si ça marchait toujours et ça marche pas et j'ai peur que ça fasse pareil...je sais pas si j'ai été claire... :x

Le code ne marche pas quand je teste le nom de fichier, enfin si il y a affichage avec msgbox du nom du fichier mais après ça bugg.... 

Private Sub Code()

Dim oShell As Object
Dim oFolder As Object
Dim oFolderItem As Object
Dim Chemin As String, Fichier As String

Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "c:\")
If oFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical
Else
  Set oFolderItem = oFolder.Self
  Chemin = oFolderItem.Path & "\"
End If
    Fichier = Dir(Chemin & "*.xls")
    'Boucle sur les fichiers
    Do While Len(Fichier) > 0
        'ICI ON PEUX TESTER PAR EXEMPLE LE NOM DU FICHIER
        'AVANT DE L'OUVRIR
        'MsgBox (Fichier)
        If Mid$(Fichier, 6, 2) = "01" Then
        Workbooks.Open Chemin & Fichier
        MsgBox (Fichier)
        'blablablabla
        'MsgBox ActiveWorkbook.Name
        ActiveWorkbook.Close
        Fichier = Dir
        End If
    Loop
End Sub
0