rapidité Macro

[gildas lechat]

Bonjour le forum,

Vous trouverez ci dessous une macro me permettant de chercher le nom d'un sous-dossier dans un dossier ainsi que le ficher Excel.
La macro fonctionne correctement.
Néanmoins j'ai des centaines de sous-dossier et la macro est un peu lente.

Je cherche à améliorer la macro.
Si vous avez un correctif a apporter, je suis preneur.

Public DossierChoisi
Public dossierSource As String
Public fichierSource As String

Private Sub CommandButton1_Click()

DossierRapportDeMicrosection = "P:\XXXXXX" 'Remplacer le dossier source de recherche

Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(DossierRapportDeMicrosection)
Set fc = f.SubFolders

For Each f1 In fc
If TextBox1.Value = f1.Name Then
DossierChoisi = f1
Label3.Caption = f1
found = True
End If
Next f1

If found = False Then
Label3.Caption = "Pas de dossier correpondant au nom specifie"
End If


End Sub

Merci d'avance
Gildas

 

[Gorfael]

Re : rapidité Macro

Salut gildas lechat et le forum
J'ai pas regardé ton fichier, juste ta macro. Améliorer sa vitesse... pas sûr. Mais raccourcir sa durée, peut-être :

Public DossierChoisi
Public dossierSource As String
Public fichierSource As String

Private Sub CommandButton1_Click()
Dim fs, f, f1, fc, s
Dim Flg As Boolean

DossierRapportDeMicrosection = "P:\XXXXXX" 'Remplacer le dossier source de recherche

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(DossierRapportDeMicrosection)
Set fc = f.SubFolders

For Each f1 In fc
    If TextBox1.Value = f1.Name Then
        DossierChoisi = f1
        Label3.Caption = f1
        Flg = False
        Exit For
    End If
Next f1

If Flg Then Label3.Caption = "Pas de dossier correpondant au nom specifie"

End Sub

Différence essentielle avec ta macro : si je trouve, je sors, je ne continue pas.

L'indentation n'est pas là pour "rendre le code plus beau". Juste pour savoir où se situe chaque instruction (Boucle, test, etc;;😉
A+

 

[gildas lechat]

Re : rapidité Macro

Bonjour Gorfael, le forum


Merci pour ta réponse.🙂
Effectivement, le recherche est plus rapide pour les dossiers se trouvant en debut de liste, la macro stop dès que le dossier est trouvé.
Petit bemol, le message suivant ne fonctionne pas :

If Flg Then Label3.Caption = "Pas de dossier correpondant au nom specifie"

Je prend l'amélioration en compte mais existe t'il un autre moyen pour améliorer le temps d'exécution général sur cette macro ( rappel plusieurs centaines de sous-dossier présent pour la recherche) ?


Merci
Gildas

 

[Gorfael]

Re : rapidité Macro

Salut gildas lechat et le forum
Voilà ce que c'est d'être dérangé en pleine réponse 😀
il faut renplacer

For Each f1 In fc

par

Flg=True
For Each f1 In fc

Mettre la variable à Vrai avant d'entrer dans la boucle. Si on trouve, on la met à Faux, puis on sort et on teste Flg.

Pour la vitesse, je ne suis pas assez compétent (en un seul mot).
A+

 

[Staple1600]

Re : rapidité Macro

Bonsoir tout le monde


Pour la vitesse, je n'utiliserai pas Excel dans ce cas présent
mais un simple batch

Copier les deux lignes ci-dessous dans le bloc-notes

@echo off
dir/s/b %1>c:\liste.txt

et enregistrer ce fichier en le nommant par exemple: listfic.bat
(dans un premier temps dans le répertoire idoine)
Ensuite à partir d'une invite MsDos
saisir par exemple:
listfic c:\temp\*.xls

Tu obtiendras un fichier texte avec les noms de tous les fichiers xls
présents dans c:\temp et ses sous répertoires

On peut aussi utiliser ce batch par le biais de VBA.

 

[gildas lechat]

Re : rapidité Macro

Bonjour Gorfael, stapel 1600, le forum,

Merci pour vos réponses.

Je suis interessé pour tester la solution de stapel 1600.
Par contre est elle adapter pour une utilisation via un "panneau de contrôle" utilisé par plusieurs utilisateurs.
Je ne vois pas comment la mettre en application en gardant le principe de l'userfom.

Gildas

 

[Staple1600]

Re : rapidité Macro

Bonjour


Un début d'explication (pas trop de temps ce midi)

Voici un exemple de procédure lançant un batch à partir d'Excel

Sub run_batch()
dim strPar as String
strPar="c:\temp\*.xls"
RetVal = Shell("C:\temp\listfic.bat " & strPar, 1)
End Sub

Si tu veux utiliser un TextBox
Remplaces ceci
strPar="c:\temp\*.xls"
par
strPar=TextBox1

PS: dans ce cas le code de la macro devra être dans un Userform associé un CommandButton par exemple

Private Sub CommandButton1_Click()
dim strPar as String
strPar=TextBox1
RetVal = Shell("C:\temp\listfic.bat " & strPar, 1)
End Sub

Tu peux aussi essayer cette variante du Batch
(pour avoir ta liste dans un fichier Excel)

@echo off
dir/s/b %1>c:\liste.xls

 

[gildas lechat]

Re : rapidité Macro

Merci Staple1600,

Je vais essayer de mettre en oeuvre ta solution pour mon info..

Que penses tu de ce code?:

Private Sub CommandButton1_Click()

DossierRapportDeMicrosection = "P:\xxx\"

NOMREP = Dir(DossierRapportDeMicrosection & TextBox1.Value & "\a-*")
If NOMREP = "" Then
Label3.Caption = "Pas de dossier correspondant au nom specifie"
Else
Label3.Caption = "P:\Atelier CONTROLES\Rapport de microsection\" & TextBox1.Value & "\" & NOMREP '"P:\xxx\" & TextBox1.Value ' NOMREP
End If

il fonctionne et c'est rapide
Gildas