[VBA] Liste en fonction de fichierS .csv

yoy91 -  
yoyoyo91 Messages postés 14 Statut Membre -
Bonjour,

Petite question compliquée,

J'ai :
- un fichier Excel qui par macro créé des fichier .csv contenant certaines informations
- un dossier rempli d'une multitude de fichiers .csv (environ 2000)
- un fichier Excel qui me sert de base de donnée et qui doit récupérer les informations contenue dans chaque .csv

Mon problème concerne la création de la liste car j'ai besoin de la mettre à jour régulièrement mais j'ouvre chaque fichier .csv alors le traitement est très long.

J'aurais besoin de trouver un moyen pour réduire considérablement le temps de traitement (ouvrir tout en 1 fois, ...pas d'autre idée).

Est ce que quelqu'un pourrait éclairer ma lanterne ?

Merci pour votre aide et votre temps. 

Sub Macro_RTlist()
'Macro permettant la génération de la liste des rapports

Dim Start, Ending, Temps As Date
Call ScreenUpdating_Off

Start = Time

Dim wb_CSV As Workbook
Dim Rep, Fichier, var_report As String
Dim cpt_file, cpt_lin, var_car As Integer

var_dashyear = "Dashboard_" & Worksheets("DASH").Range("DASH_Year").Value

Rep = "M:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("DASH").Range("DASH_Year").Value & "\"
Fichier = Dir(Rep)
cpt_file = 7
Do While Fichier <> ""
cpt_file = cpt_file + 1
var_car = Len(Fichier)
var_car = var_car - 4
var_report = Left(Fichier, var_car)

Sheets("RT_list").Range("A" & cpt_file) = var_report
Fichier = Dir

Workbooks.Open Filename:="M:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("DASH").Range("DASH_Year").Value & "\" & var_report & ".csv", Local:=True

Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 2).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Cells(1, 1).Value
Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 5).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Range("B1").Value
Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 7).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Range("C1").Value
Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 8).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Range("D1").Value
Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 9).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Range("E1").Value
Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list").Cells(cpt_file, 3).Value = Workbooks(var_report & ".csv").Worksheets(var_report).Range("F1").Value

Workbooks(var_report & ".csv").Close
Loop

ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Add Key:=Range("A7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Call ScreenUpdating_On
Ending = Time
Temps = Ending - Start
MsgBox (Temps)
Exit Sub

FIN:

Call ScreenUpdating_On

End Sub

7 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    A essayer car je n'ai pas 2000 fichiers csv 

    Sub Macro_RTlist()
    'Macro permettant la génération de la liste des rapports
    Dim Start, Ending, Temps As Date
    Dim wb_CSV As Workbook
    Dim Rep, fichier, var_report As String
    Dim cpt_file, cpt_lin, var_car As Integer
   
    Call ScreenUpdating_Off

    Start = Time
    var_dashyear = "Dashboard_" & Worksheets("DASH").Range("DASH_Year").Value
    Rep = "M:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("DASH").Range("DASH_Year").Value & "\"
    fichier = Dir(Rep)      ' & "*.csv")
    cpt_file = 7
    Do While fichier <> ""
        cpt_file = cpt_file + 1
        'Nom de fichier SANS extention
        var_report = Left(fichier, Len(fichier) - 4)
        Sheets("RT_list").Range("A" & cpt_file) = var_report
        ThisWorkbook.Names.Add "plage", RefersTo:="='" & Rep & "[" & fichier & "]" & var_report & "'!$A$1:$F$1"
        'ajoutez une feuille et changez le nom en dessous
        'il est possible de la faire par programme, mais je ne sais pas quel classeur est ouvert avec cette macro !!!
        With Sheets("Feuil2")
            .[A1:F1] = "=plage"
            TInfos = .[A1:F1]
            With Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list")
                .Cells(cpt_file, 2).Value = TInfos(1, 1)
                .Cells(cpt_file, 5).Value = TInfos(1, 2)
                .Cells(cpt_file, 7).Value = TInfos(1, 3)
                .Cells(cpt_file, 8).Value = TInfos(1, 4)
                .Cells(cpt_file, 9).Value = TInfos(1, 5)
                .Cells(cpt_file, 3).Value = TInfos(1, 6)
            End With
            .[A1:F1].Clear
        End With
        fichier = Dir
    Loop
    ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Add Key:=Range("A7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Call ScreenUpdating_On
    Ending = Time
    Temps = Ending - Start
    MsgBox (Temps)
    Exit Sub

FIN:
    Call ScreenUpdating_On
End Sub
    0
  2. yoyoyo91 Messages postés 14 Statut Membre
     
    Salut,

    Merci pour la réponse rapide.
    Je viens de tester ta solution mais elle ne marche pas totalement.
    En fait les valeurs ne s'actualise pas et je me retrouve avec des ref.

    0
    1. yoyoyo91 Messages postés 14 Statut Membre
       
      Avec ceci (ligne 23-25) ça marche, mais ça re-devient très long... 

      Sub Macro_RTlistgnh()
    'Macro permettant la génération de la liste des rapports
    Dim Start, Ending, Temps As Date
    Dim wb_CSV As Workbook
    Dim Rep, fichier, var_report As String
    Dim cpt_file, cpt_lin, var_car As Integer
   
    Call ScreenUpdating_Off

    Start = Time
    var_dashyear = "Dashboard_" & Worksheets("DASH").Range("DASH_Year").Value
    Rep = "M:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("DASH").Range("DASH_Year").Value & "\"
    fichier = Dir(Rep)
    cpt_file = 7
    Do While fichier <> ""
        cpt_file = cpt_file + 1
        var_report = Left(fichier, Len(fichier) - 4)
        Sheets("RT_list").Range("A" & cpt_file) = var_report
        ThisWorkbook.Names.Add "RANGE", RefersTo:="='" & Rep & "[" & fichier & "]" & var_report & "'!$A$1:$F$1"
        Workbooks.Open Filename:="M:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("DASH").Range("DASH_Year").Value & "\" & var_report & ".csv", Local:=True
        Workbooks("Dashboard_2017.xlsm").Activate
        With Sheets("Feuil2")
            .[A1:F1] = "=RANGE"
            TInfos = .[A1:F1]
            With Workbooks(var_dashyear & ".xlsm").Worksheets("RT_list")
                .Cells(cpt_file, 2).Value = TInfos(1, 1)
                .Cells(cpt_file, 5).Value = TInfos(1, 2)
                .Cells(cpt_file, 7).Value = TInfos(1, 3)
                .Cells(cpt_file, 8).Value = TInfos(1, 4)
                .Cells(cpt_file, 9).Value = TInfos(1, 5)
                .Cells(cpt_file, 3).Value = TInfos(1, 6)
            End With
            .[A1:F1].Clear
        End With
        fichier = Dir
        Workbooks(var_report & ".csv").Close (False)
    Loop
    ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort.SortFields.Add Key:=Range("A7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RT_list").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   Call ScreenUpdating_On
    Ending = Time
    Temps = Ending - Start
    MsgBox (Temps)
    Exit Sub

FIN:
    Call ScreenUpdating_On
End Sub
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > yoyoyo91 Messages postés 14 Statut Membre
         
        Re,
        Ben oui, si vous ouvrez les fichier csv, ça redevient long !!!!!!!
        Serait-t-il possible d'avoir un de vos fichiers csv ???
        0
  3. yoyoyo91 Messages postés 14 Statut Membre
     
    Vous allez trouver ça con, mais je n'arrive pas à trouver le bouton pour insérer des pièces jointes dans les messages sur ce forum.

    Voici une image, rien de très compliqué.



    0
  4. yoyoyo91 Messages postés 14 Statut Membre
     
    Vous allez trouver ça con, mais je n'arrive pas à trouver le bouton pour insérer des pièces jointes dans les messages sur ce forum.

    Voici une image, rien de très compliqué.



    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    Pour transmettre un fichier,
    Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
    il faut passer par un site de pièce jointe tel que cjoint.com

    Allez sur ce site : https://www.cjoint.com/
    Clic sur parcourir,
    Cherche ton fichier,
    clic sur ouvrir,
    Clic sur "Créer le lien cjoint",
    Copier le lien,
    Revenir ici le coller dans une réponse...

    Dans votre repertoire, il y a que des fichiers csv ???
    0
  7. yoyoyo91 Messages postés 14 Statut Membre
     
    https://www.cjoint.com/c/FJbioC3frKU
    https://www.cjoint.com/c/FJbipdxTh2U

    Voici les liens vers le fichier à remplir et un exemple de fichier csv.

    Oui, il n'y a que des fichiers csv

    Merci pour votre aide
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Je recupere vos fichiers. Pourquoi recuperez-vous les donnees csv en partant d'une liste et une instruction dir qui ne confirme pas la presence des fichiers ??????
      0
    2. yoyoyo91 Messages postés 14 Statut Membre
       
      Euh....peut être parce que je ne m'y connais pas tant que çe en VBA.
      Pour l'instant j'essaie juste de résoudre ma problématique principale, il y aura surement des ajustements et de controles à faire après...mais je n'y ai pas encore réfléchi.
      De plus, je collecte surtout des informations sur internet et j'essaie d'en sortir quelque chose...

      Merci
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > yoyoyo91 Messages postés 14 Statut Membre
         
        Re,

        En effet, avec votre fichier csv il y a probleme, si je le reenregistre plus de probleme.
        Je cherche le pourquoi
        0
  8. yoyoyo91 Messages postés 14 Statut Membre
     
    Je vous communique le code qui me permet de créer le fichier csv : 

    '== Boucle 3 : Créer le fichier .csv ==
CSV = "F:\Jambon\# Mettre à jour\WKND-37\#_2017\" & Worksheets("NUM").Range("Num_Year").Value & "\" & var_report & ".csv"

Open CSV For Output As #1 'Ouvre le fichier en écriture
    Print #1, var_technician & ";" & var_customer & ";" & var_project & ";" & var_phase & ";" & var_DVP & ";" & var_test
Close #1
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      C'est peut-etre la le pourquoi !!!!!

      Je regarde la chose
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
       
      Re,

      En changeant de methode pour recuperer les infos avec une boucle de 2000, temps d'execution=90s. Methode Referto=66s, mais pour le moment marche pas avec vos fichiers
      Je planche pour voir avec la Methode Referto
      0
    3. yoyoyo91 Messages postés 14 Statut Membre
       
      Merci encore pour l'aide.

      Uniquement avec mes fichiers ?
      Si vous avez une autre méthode, je ne suis pas fermé non plus sur la méthode de création de ces fichiers csv.
      0
    4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > yoyoyo91 Messages postés 14 Statut Membre
       
      Re,

      C'est aussi une appli excel qui cree les csv ????

      Uniquement avec mes fichiers ?
      Eh ben non! Ce matin, ce qui marchait hier avec "mes" fichiers csv, ne marche plus, c'est pour cela que j'ai change de methode.

      90s pour 2000 fichiers, ca doit le faire ou pas, car je viens de voir que votre fichier xlsm a 5000 lignes en RT_List !!!!!!!!!!!!!!!!!!!
      0
    5. yoyoyo91 Messages postés 14 Statut Membre
       
      Oui

      En fait, je vous explique en détail.
      J'ai un fichier qui me sert de support pour créé les fichier .csv et un fichier qui doit lire les noms de ces fichiers et me créer une liste avec les informations contenues dans tous ces fichiers.

      Ce système représente un peu un système de ticket où mes utilisateurs (une multitude) prennent à leur tout un ticket et renseigne les données de base (nom, ...).
      Et j'ai besoin d'un listing centralisant ces informations (qui a pris le ticket n°1,2,...).

      90s pour 2000 fichiers est largement OK pour moi.
      0