Microsoft 365 Optimiation de macro

[Akortys]

Bonjour,

J'ai une macro qui a été réalisé par un de mes amis.
Cette macro, scrute un ensemble de répertoire et de sous répertoire pour en retirer des informations et les insérer dans le fichier excel en question.

Le temps d’exécution de cette macro est extrêmement long. L'objectif est donc d'optimiser cette macro si possible. Je ne vois pas comment je peux l'optimiser sachant que mes compétences sont limitées sur le sujet.

Pour le bon fonctionnement, il y a un module a activé => Ce lien n'existe plus

La partie copy des information dans les deux autres fichiers Excel peut être commentée, ce n'est pas une partie gourmande en ressource, enfin je crois.

Si vous aviez un moment pour jeter un coup d'oeil et m'aiguiller dans la réflexion, ce serait sympathique.

En vous remerciant du temps passé.

Bonne journée

 

[Akortys]

Pour info, je pense que ça ne correspond pas aux besoins car d'une part, le code ne liste pas l'ensemble des fichiers. Si je change le code pour remonter les fichiers de type .csv cela ne fonctionne pas, il me remonte uniquement les dossiers.
Je dois changer cette ligne

If Right(ItemVu, 5) Like ".xls*" Then

en

If Right(ItemVu, 4) Like ".csv*" Then

Mais cela n'alimente pas le tableau comme dans l'explication de code

 

[Dudu2]

Bonjour,
Perso je ne suis pas sûr de comprendre ce que cherches à faire.

- On prend l'information de la colonne C+ligne2,
- FichierCherche = Fichier recherché : valeur de c2 + ".csv"

Donc tu cherches un fichier de nom FichierCherche, dans le répertoire RepertoireDeTravail & "\machines" et ses sous-répertoires. C'est bien ça ?

 

[patricktoulon]

bonjour
POUR INFO quand on parle de csv on parle pas de colonne h x ou y les fichier csv sont des fichiers texte et non des tableau c'est l'ouverture dans excel qui les interprète comme tel
donc ExecuteExcel4Macro ON OUBLIE !!!!!!!
te reste plus qu'ADO pour obtenir les données des fichiers fermé
conclusion si tu trouvait compliqué ma méthode ben tu n'es pas au bout de tes peines avec ADO

d'autant plus que tu donne les directives au compte goutte
ben a ce rythme on est pas arrivé

peut etre une fonction perso avec open for input pour lire la données ligne2 apres le 3eme ";"

 

[Dudu2]

Pour la recherche des fichiers je propose une autre méthode qui consiste à parcourir tout le bazar 1 seule fois au début et stocker les noms de fichiers .csv et leurs répertoires en table. Je l'ai déjà codé.
En suite suffit de scanner la table.

Mais c'est vrai que les .csv on ne peut pas les lire avec Excel4Macro. Donc va falloir les ouvrir en tant que fichiers texte et chercher l'équivalent de la cellule D2. De toutes façons ce sera 10x (?) plus rapide que de les ouvrir en tant que classeur.

Il me faudrait un exemple de .csv pour compléter le code.

 

[patricktoulon]

salut dudu2 ya qu'a demander
c'est kado' la fonction

Function GetCellOnClosedCsv(fichier, rng As Range)
    Dim laChaine As String, x, chaine$
    x = FreeFile
    Open fichier For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x
    lig = rng.Row - 1: col = rng.Column - 1
    On Error GoTo erreur
    chaine = Split(laChaine, vbCrLf)(lig)
    chaine = Split(chaine, ";")(col)
    GetCellOnClosedCsv = chaine
    Exit Function
erreur:
    GetCellOnClosedCsv = "NotFound!!"

End Function

'sub pour tester sur un fichier
Sub test()
    MsgBox GetCellOnClosedCsv("C:\Users\polux\DeskTop\exo.csv", [D2])
End Sub

et l'adaptation sur mon model de dir récursif

Sub testXy()
    Cells.Clear
    Dim liste As Variant
    liste = DirList("G:\vba excel\")
    Cells(1, 1).Resize(UBound(liste(0)), 1).Value = Application.Transpose(liste(0))
    Cells(1, 2).Resize(UBound(liste(1)), 1).Value = Application.Transpose(liste(1))


End Sub

Function DirList(Dossier As String, Optional recall As Boolean = False, Optional tbl As Variant, Optional tblval As Variant) As Variant
    Dim ItemVu As String, directory As Variant, SubFolderCollection As Collection, I As Long, A As Long, E As Long
    Set SubFolderCollection = New Collection
    If recall = False Then ReDim tbl(0): ReDim tblval(0)   ' si recall  on redim un tableau  de zero item (pour la creation du tableau)
    On Error Resume Next    'gestion des fichiers dossiers system et interdit ou generant une erreur(PerLog,recycle,etc..)
    ItemVu = Dir(Dossier, vbDirectory)
    If Error.Number = 0 Then    ' si pas d'erreur on examine le contenu
        'examen  du dossier courrant
        Do Until ItemVu = vbNullString
            If Left(ItemVu, 1) <> "." Then
                If (GetAttr(Dossier & ItemVu) And vbDirectory) = vbDirectory Then
                    SubFolderCollection.Add ItemVu
                Else
                    If Right(ItemVu, 5) Like "*.csv" Then
                        A = UBound(tbl) + 1
                        ReDim Preserve tbl(1 To A): tbl(A) = Dossier & ItemVu
                        ReDim Preserve tblval(1 To A): tblval(A) = GetCellOnClosedCsv(Dossier & ItemVu, [D2])

                    End If
                End If
            End If
            ItemVu = Dir()
        Loop
    Else
        Err.Clear
    End If
    'examen des sub dossier
    For Each subdossier In SubFolderCollection
        'A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & subdossier
        DirList Dossier & subdossier & "\", True, tbl, tblval
    Next subdossier
    DirList = Array(tbl, tblval)
End Function

LOL

 

[Dudu2]

Merci pour la fonction, je vais m'en inspirer

 

[patricktoulon]

RE
j'ai testé mon model recursif +ma fonction ca marche je récupere bien la 4eme donnée de la ligne 2 de mes csv

 

[Akortys]

Bonjour,

Je vois que la mise en place de code fuse. Mais je ne suis pas sûr que tout cela réponde à mon besoin.

Pour rappel mon besoin est le suivant :

Dans le fichier source (celui où la macro s'exécute).
On ne supprime pas les données de ce fichier, on vient seulement remplacer les valeurs parce celles exécuter dans la macro ou en ajouter.

RepertoireDeTravail = répertoire fichier qui contient macro

BOUCLE A FAIRE sur les lignes :

• On prend l'information de la colonne C+ligne2,
• FichierCherche = Fichier recherché : valeur de c2 + ".csv"
• On prend l'information de la colonne H+ligne2 si vide alors on prend information de la colonne F+ligne2 =>>> variable DebutNom
• On recherche FichierCherche dans RepertoireDeTravail & "\machines"
• Si pas de fichier trouvé, on met dans la colonne N+ligne2 "Pas de fichiers Machine trouvé"
• Si fichier trouvé, on récupére la valeur de la colonne D pour la ligne 2 (variable DonneeSource par exemple),
• On se positionne sur le fichier source, et on vient coller la valeur DebutNom & "_" & DonneeSource dans colonne N + ligne2

J'ai l'impression que dans ton code, tu scrutes les dossiers et sous-dossiers et dès que tu trouves le fichier qui va bien tu en récupére une donnée en D2 pour l'insérer dans un autre fichier ou tu construis un tableau.

Je suis désolé mais sur excel, j'ai certainement moins de compétences et du coup je suis plus long à comprendre. Par contre, mon besoin fonctionnel, je le connais très bien et c'est celui qui est exprimé ci-dessus.

Merci d'avance.

 

[patricktoulon]

ta demande initial etait récupérer la [D2] dans des fichiers (dont il s’avère que c'est des CSV) mais ca on l'a su après 20 post!!!!!!!);ces fichiers étant disséminé un peu partout dans des sous dossiers

je t'ai donné une reponse concrete avec les fonctions qui vont bien
voir démo
maintenant c'est a toi d'en adapter la mise en oeuvre

 

[Dudu2]

J'ai recodé la macro, sans pouvoir tester globalement évidemment.
Les fonctions ont été testées individuellement.
A ajuster si nécessaire...

 

[Akortys]

Oui effectivement je te joins un fichier csv. Il faut le dézipper car on ne peut joindre un .csv.

La base c'est effectivement ce qui a été dit plus haut.

Je pense que la technique de stocker tous les fichiers type .csv
de parcourir chaque ligne du fichier source "ClientMachine.....csv" de prendre la valeur de la colonne C
Rechercher cette valeur.csv dans la table des fichiers csv.
Si fichier trouvé alors on récupére la 4eme valeur de ce fichier que l'on vient mettre dans le fichier source "ClientMachine" en colonne N
et ainsi de suite .....


Pour répondre à la question :

Donc tu cherches un fichier de nom FichierCherche, dans le répertoire RepertoireDeTravail & "\machines" et ses sous-répertoires. C'est bien ça ?

Non, FichierCherche c'est la variable qui correspond à la description fait ci-dessus, par exemple données en C2 du fichier source.csv

C'est vrai que ce n'est pas toujours clair, mais j'essaie de faire au mieux

 

[Akortys]

Oui et d'ailleurs je ne te remercierai jamais assez du travail accompli dans des délais aussi court. Mais il me semblait avoir été clair, mais apparemment pas assez . La valeur D2 n'est qu'un exemple de ligne valeur à parcourir, il faut mettre en place une boucle pour effectuer le travail sur toutes les lignes du travail initial.

 

[Dudu2]

Ok le CSV confirme que le séparateur est bien ";".
Pour les reste j'ai complètement perdu pied
J'en resterai donc au fichier que je t'ai proposé (message #25) qui n'est sans doute pas ce que tu veux faire. Ou peut-être...

 

[Akortys]

Il ne faut pas perdre espoir.
J'ai testé ton fichier et cela semble répondre en tout point à mon besoin.
Il faut que je le teste tout de même de fond en comble mais les temps de réponse semblent inégalable.

Je regarde cela et te tiens informer.

Merci

 

[Dudu2]

'C'est quoi cet horrible -11 ?
RepertoireDeTravail = Left(RepertoireDeTravail, (Len(RepertoireDeTravail) - 11))