[VBA] Liste en fonction de fichierS .csv

yoy91 -
yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention - 1 oct. 2016 à 14:54

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

A voir également:

[VBA] Liste en fonction de fichierS .csv
Liste déroulante excel - Guide
Fonction si et - Guide
Liste déroulante en cascade - Guide
Renommer des fichiers en masse - Guide
Explorateur de fichiers - Guide

7 réponses

Réponse 1 / 7

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 2 / 7

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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.

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

Re,
Ben oui, si vous ouvrez les fichier csv, ça redevient long !!!!!!!
Serait-t-il possible d'avoir un de vos fichiers csv ???

Réponse 3 / 7

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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é.

Réponse 4 / 7

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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é.

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

Posez votre question

Réponse 5 / 7

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 ???

Réponse 6 / 7

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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 ??????

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

Re,

En effet, avec votre fichier csv il y a probleme, si je le reenregistre plus de probleme.
Je cherche le pourquoi

Réponse 7 / 7

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
C'est peut-etre la le pourquoi !!!!!

Je regarde la chose

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > f894009 Messages postés 17277 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

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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 !!!!!!!!!!!!!!!!!!!

yoyoyo91 Messages postés 14 Date d'inscription Statut Membre Dernière intervention

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.

Votre réponse