[VBA] Liste en fonction de fichierS .csv Fermé

Question

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

f894009 · Answer

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

yoyoyo91 · Answer

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 · Answer

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

yoyoyo91 · Answer

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

f894009 · Answer

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

yoyoyo91 · Answer

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

yoyoyo91 · Answer

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

[VBA] Liste en fonction de fichierS .csv

7 réponses

Discussions similaires