EXCEL: Macro Gestion Donnees Résolu/Fermé

Question

Bonjour a tous,

Je suis nouveau sur le forum qui a l air super dynamique, donc je fais appel a votre aide.

je suis debutant en macro et j ai un travaille a rendre pour mon stage.

Je dois faire une macro pour optimiser et pour gagner du temps dans la gestion de donnees.

Mais mon probleme est que les fichiers excel que je dois rassembler dans un seul, ne sont pas similaires. En effet le nombre de lignes et colonnes sont variables, les positions des colonnes a classer ne sont pas les memes, le nom des colonnes varient et toutes les colonnes des fichiers d origine ne sont pas a utiliser. 

Le but de la macro est de classer les colonnes dans le meme ordre pour tous les fichiers (Je pense qu une recherche par nom serait le plus simple) et puis de rassembler toutes les informations stockees dans la meme colonne de chaque fichier dans une unique colonne dans un nouveau fichier. 

De plus les fichiers sont stockes dans des  fichiers differents, chaque fichier represente une annee. Voila les etapes que j ai pense mettre en place: 

1) Mettre tous les fichiers dans un meme dossier
J'ai des difficultes car tout d abord je suis novice et le nom des fichiers n'ont pas le meme format, mais il y a des mots en commun donc une recherche par tags serait possible, mais je ne sais pas comment la mettre en place..

2) Mettre tous les feuilles de tous les fichiers dans un meme fichier. On retrouve le meme probleme, les noms sont differents,  mais il y a des mots en commun donc une recherche par tags serait possible, mais je ne sais pas comment la mettre en place..

3) Supprimer les feuilles qui ne sont pas utiles: La cela est plus facile, les feuilles qui sont interessantes on le mem type de nom

4) Classer dans chaque feuille les colonnes qui nous interessent et supprimer les autres.  On retrouve le meme probleme, les noms sont differents,  mais il y a des mots en commun donc une recherche par tags serait possible.

5) Mettre bout a bout les informations stockees dans les colonnes ayant la meme position dans chaque feuille. Ce rassemblement doit etre fait fichier par fichier (voir etape suivante).

J ai reussi partiellement a faire cela.


6) Apres copie des informations pour chaque feuille on doit rajouter dans la premiere colonne (laisser libre au debut) le mois et l annee (contenu dans le nom de chaque fichier). 

Je ne vois pas du tout comment faire

7) Quand toutes les colonnes ont ete copiees, et chaque mois et annee a ete rajouter pour chaque feuille, faire une sauvegarde dans le dossier ou ont ete stockes tous les fichiers d origine

Ca c'est bon.


Et oui tout cela semble bien complique et je sais pas si c est faisable car pour le moment je suis a court d idees.
Mais beaucoup m ont l air tres talentueux :)

Je vous remercie beaucoup pour votre aide.

Et bonne continuation avec notre excel.


MB

PS: j espere que vous m avez compris, cela est aussi dur a realiser qu'a expliquer ;)
Desole pour l'absence d'accent mais je suis a Singapour et nous en n'avons pas. ;)

pijaku · Accepted Answer

Bonjour,
Si tu veux, on va prendre ça par étape...

Etape 1 : Mettre tous les fichiers dans un meme dossier 
Nous aurions pu écrire une code pour cela, mais frédéric Sigonneau l'a déjà fait

Alors... adaptons :

Sub arborescenceRepertoire()
  racine = ChoixDossier()
  If racine = "" Then Exit Sub
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   For Each f In dossier.Files
'ICI se joue tout!!!
'Si le nom du fichier contient "frais" alors on a un message qui nous donne son nom
        If f.Name Like "*frais*" Then MsgBox f.Name
   Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub
Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function
Regarde déjà ce code qui réponds à ta première interrogation. Une fois assimilé, on passera à la seconde.

ambr92 · Answer

Bonjour,

Merci beaucoup pour ta reponse tres rapide et developpee.

J'ai quelques questions a te poser, pour bien comprendre ton code:

- Peux t on mettre plusieurs tags comme condition de la boucle if par exemple:

 If f.Name Like "*frais*&*poisson*" Then MsgBox f.Name

-  Dans cette boucle "Each f In dossier.Files", f=file, mais comment excel sait qu'il faut prendre les fichiers? Car tu n'as pas dit a quoi correspondait f avant?

- Peux tu me fournir, si tu as le temps :), une petite explication de la fonction: ChoixDossier(), car j ai beaucoup de difficultes a comprendre ce que tu fais.

Merci encore pour ton aide :)

Cordialement.

MB

pijaku · Answer

2) Mettre tous les feuilles de tous les fichiers dans un meme fichier.
Ici quelques questions s'imposent :
> Nombre de fichiers à traiter,
> Nombre de feuilles par fichier,
> Version d'excel utilisée (question subsidiaire car on va faire en sorte que la macro finale soit "portable" d'une version à l'autre)

pijaku · Answer

BONJOUR! <------- Elément indispensable à une bonne discussion, même avec 6-7h de décalage... 1- Dis? Tu crois pas que tu exégères dans la confidentialité? Ne pas fournir un fichier, je veux bien, à la rigueur, s'il contient des infos personnelles. Mais là, ne pas vouloir fournir un mot commun à tes noms de fichier, ni un mot commun à tes noms de feuilles??????? T'en fais pas un peu trop? A moins que ces mots communs soient : "plan" "bombe" "atomique" ..... Bref. 2- Essaie ce code (lancer la procédure : "MainProcedure") : Option Explicit Dim RepFich() As String Dim i As Integer Sub MainProcedure() Dim racine As String Dim fs As Object, dossier_racine As Object racine = ChoixDossier() If racine = "" Then Exit Sub i = 1 Set fs = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fs.getfolder(racine) Lit_dossier dossier_racine ImportDonnees End Sub Sub Lit_dossier(ByRef dossier) Dim f, d For Each f In dossier.Files If f.Name Like "*Classeur*" And Left(Split(f.Name, ".")(1), 3) = "xls" Then ReDim Preserve RepFich(1 To 2, 1 To i) RepFich(1, i) = dossier RepFich(2, i) = f.Name i = i + 1 End If Next For Each d In dossier.SubFolders Lit_dossier d Next End Sub Sub ImportDonnees() Dim WbkRecap As Workbook, WbkSource As Workbook Dim Feuille As Worksheet Set WbkRecap = ThisWorkbook Application.ScreenUpdating = False For i = LBound(RepFich, 2) To UBound(RepFich, 2) Set WbkSource = Workbooks.Open(RepFich(1, i) & "\" & RepFich(2, i)) For Each Feuille In WbkSource.Worksheets If Feuille.Name <> "Feuil2" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count) Next Feuille Application.DisplayAlerts = False WbkSource.Close Application.DisplayAlerts = True Next i Application.ScreenUpdating = True Set WbkRecap = Nothing Set WbkSource = Nothing End Sub Function ChoixDossier() If Val(Application.Version) >= 10 Then With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ActiveWorkbook.Path & "\" .Show If .SelectedItems.Count > 0 Then ChoixDossier = .SelectedItems(1) Else ChoixDossier = "" End If End With Else ChoixDossier = InputBox("Répertoire?") End If End Function

pijaku · Answer

Point par point : Les noms de fichiers : Dans la Sub Lit_dossier(ByRef dossier), remplace : If f.Name Like "*Classeur*" And Left(Split(f.Name, ".")(1), 3) = "xls" Par : If Left(Split(f.Name, ".")(1), 3) = "xls" Then If f.Name Like "*insurance*" Or f.Name Like "*customer*" Then ReDim Preserve RepFich(1 To 2, 1 To i) RepFich(1, i) = dossier RepFich(2, i) = f.Name i = i + 1 End If End If Les noms des feuilles : Dans la Sub ImportDonnees(), remplace : If Feuille.Name <> "Feuil2" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count) Par : If Feuille.Name = "Global" Or Feuille.Name = "Sheet1" Then Feuille.Copy after:=WbkRecap.Worksheets(WbkRecap.Worksheets.Count) Pour les colonnes : Ce n'est que de la mise en place, donc tu va pouvoir finir seul avec ces indications : Supposons, puisque toutes tes anciennes colonnes sont présentes dans le nouveau fichier, que tu veuilles supprimer les colonnes : C, D, E, G, J, K, Q et R. Le code est : Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft Maintenant, si tu veux faire ça sur toutes les feuilles, une boucle s'impose. Donc : Dim Feuille As WorkSheet Application.ScreenUpdating = False For Each Feuille In ThisWorkBook.WorkSheets If Feuille.Name <> "Feuil1" Then With Feuille .Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft End With End If Next Application.ScreenUpdating = True idem pour "l'échange" de place des colonnes. Supposons, qu'après avoir supprimé tes colonnes tu souhaites placer la colonne H à la place de D. Dans la même boucle intégrer : .Columns("H:H").Cut .Columns("D:D").Insert Shift:=xlToRight Ce qui nous donne une nouvelle Sub : Sub ArrangeColonnes() Dim Feuille As WorkSheet For Each Feuille In ThisWorkBook.WorkSheets If Feuille.Name <> "Feuil1" Then With Feuille .Range("C:C,D:D,E:E,G:G,J:J,K:K,Q:Q,R:R").Delete Shift:=xlToLeft .Columns("H:H").Cut .Columns("D:D").Insert Shift:=xlToRight End With End If Next End Sub Cette Sub, il convient de l'appeler, dans la procédure principale (MainProcedure), comme ceci : Sub MainProcedure() Dim racine As String Dim fs As Object, dossier_racine As Object racine = ChoixDossier() If racine = "" Then Exit Sub i = 1 Set fs = CreateObject("Scripting.FileSystemObject") Set dossier_racine = fs.getfolder(racine) Lit_dossier dossier_racine ImportDonnees ArrangeColonnes End Sub

ambr92 · Answer

Merci beaucoup pour ton aide.

Je peux pas le tester ce soir, car je n ai pas les fichiers, je ferai ca demain matin.
Je te tiendrai au courant mais je vois pas pourquoi ca ne marcherai pas.

En tout cas grâce a tes conseils ca m a permis de mieux comprendre les macros.

Encore merci