Microsoft 365 Recherche dans fichier excel dans un répertoire

[Loulou27]

Bonjour,

Je voulais rechercher des choses dans des fichiers excel dans 1 répertoire mais je me rends compte que avec la fonction "Recherche" de l'explorateur, je n'ai apparemment pas ce qu'il faut comme résultat (manque des fichiers ou pas les bons)

Je pense le faire en ouvrant les fichiers excel 1 à 1 mais va prendre un temps fou je pense car j'ai plus de 6500 fichiers / mois

Avez-vous une solution simple (peut-être paramètrages windows .... autre que en passant par excel) ?

Il faut que je cherche une référence telle que ce format XX XX XX puis dans tous ces fichiers, une seconde référence en XX XX XX XX XX


De plus, les fichiers sont en xlsx donc faut -il les renommer en xls o =u cela ne sert à rien ?


N.B :
j'ai essayé avec cette fonction
FINDSTR /M /C:"*XX XX XX*" *.*

mais cela ne marche pas du tout


Merci pour votre aide

 

[Loulou27]

Merci pour le travail @dysorthographie

Voici le retour que je peux faire

1°
Message erreur à Application.Calculate

masquage de ce truc mais arrêt au fichier 600 sans rien avoir rempli



2°
Tous les 500 fichiers, j'ai le compteur qui s'incrémente mais pendant une 50aine de fichier puis reprend une fois 500 fichier

La partie "Communication" n'est pas renseignée => trouve pas ou remonte pas la bonne info ?
L'info n'est pas trouvé car il y a le * pour tout ce qui peut y avoir derrière le <- 62 F0 29

J'ai modifié
v4 = ChercherValeur(conn, "Communication", "<- 62 F0 29%", 1, 1)
et
sql = "SELECT * FROM [" & nomFeuille & "$A1:Z5000] " & _
"WHERE F" & colCherche & " LIKE '" & Replace(critere, "'", "''") & "'"


Pas d'augmentation de la mémoire excel en tous cas
Approximativement même temps que 1



3° Modification sinon, pas le début de la trame trouvée
If critere Like "*\**" Then ' Si contient wildcard
par
If critere Like "*" Then ' Si contient wildcard



Les temps de recherche se valent

Avec ces macros, la mémoire n'explosent plus

@job75
Une raison du pourquoi la mémoire prise par excel explose avec ta macro (qui ne fait pas ouvrir les fichiers)

En plus, ça prend plus de temps

 

[dysorthographie]

Bonjour Job75,
Tu as testé les autres méthodes.

Le problème avec ExecuteExcel4Macro , selon chatgpt, lechat.ia et Claude.ia c'est qu'il garderait les liens en cach.

 

[job75]

@job75
Une raison du pourquoi la mémoire prise par excel explose avec ta macro (qui ne fait pas ouvrir les fichiers)

La méthode Dir stocke en mémoire le répertoire étudié, il est très lourd.

Je crois qu'avec la méthode FileSystemObject ce n'est pas le cas, je vais voir.

 

[Loulou27]

La méthode Dir stocke en mémoire le répertoire étudié, il est très lourd.

Je crois qu'avec la méthode FileSystemObject ce n'est pas le cas, je vais voir.

OK, je comprends un peu par rapport au DIR

Pas trop grave sinon pour le FileSystemObject ; j'ai un projet avec ça je crois donc je vais essayer de mon coté

mais une macro de @dysorthographie fonctionne bien (sur les 6000 fichiers)

Je viens de lancer sur les 21000 restants pendant que le repas et on verra ce que ça donne

 

[job75]

Voici une solution avec le FileSystemObject vous pouvez la tester :

Option Explicit
Const Feuil1$ = "DOVE"
Const Feuil2$ = "Communication"
Const col1% = 1 'colonne A
Const col2% = 6 'colonne F
Const crit1$ = "Véhicule :"
Const crit2$ = "Vin :"
Const crit3$ = "Battery Identification Number :"
Const crit4$ = "<- 62 F0 29*"
Dim fichier$, lig&, trouve&

Sub Recherche()
Dim t, chemin$, fso As Object, fich As Object, form$, compte
t = Timer
chemin = ThisWorkbook.Path & "\REPERTOIRE_FICHIERS" & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
lig = 3
Application.ScreenUpdating = True
Rows(lig & ":" & Rows.Count).ClearContents 'RAZ
For Each fich In fso.GetFolder(chemin).Files
    fichier = fich.Name
    If Right(fichier, 5) = ".xlsx" Then
        compte = compte + 1
        form = "'" & chemin & "[" & fichier & "]" & Feuil1 & "'!"
        Formule form, col1, crit1, lig
        Formule form, col1, crit2, lig
        Formule form, col1, crit3, lig

        form = "'" & chemin & "[" & fichier & "]" & Feuil2 & "'!"
        Formule form, col1, crit4, lig

        If trouve = 1 Then lig = lig + 1
        trouve = 0
    End If
Next
MsgBox Timer - t
End Sub

Sub Formule(form$, col%, crit$, lig&)
Dim f$, v
f = "MATCH(""" & crit & """," & form & "C" & col & ",0)"
v = ExecuteExcel4Macro(f)
If IsNumeric(v) Then
    trouve = 1
    Cells(lig, 1) = fichier 'retourne le nom du fichier
    If crit = crit1 Then Cells(lig, 2) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Véhicule
    If crit = crit2 Then Cells(lig, 3) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Vin
    If crit = crit3 Then Cells(lig, 4) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du BIN

    If crit = crit4 Then Cells(lig, 5) = ExecuteExcel4Macro(form & "R" & v & "C" & col) 'retourne la valeur de la trame 62 F0 29
End If
End Sub

 

[Loulou27]

Voici une solution avec le FileSystemObject vous pouvez la tester :

Option Explicit
Const Feuil1$ = "DOVE"
Const Feuil2$ = "Communication"
Const col1% = 1 'colonne A
Const col2% = 6 'colonne F
Const crit1$ = "Véhicule :"
Const crit2$ = "Vin :"
Const crit3$ = "Battery Identification Number :"
Const crit4$ = "<- 62 F0 29*"
Dim fichier$, lig&, trouve&

Sub Recherche()
Dim t, chemin$, fso As Object, fich As Object, form$, compte
t = Timer
chemin = ThisWorkbook.Path & "\REPERTOIRE_FICHIERS" & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
lig = 3
Application.ScreenUpdating = True
Rows(lig & ":" & Rows.Count).ClearContents 'RAZ
For Each fich In fso.GetFolder(chemin).Files
    fichier = fich.Name
    If Right(fichier, 5) = ".xlsx" Then
        compte = compte + 1
        form = "'" & chemin & "[" & fichier & "]" & Feuil1 & "'!"
        Formule form, col1, crit1, lig
        Formule form, col1, crit2, lig
        Formule form, col1, crit3, lig

        form = "'" & chemin & "[" & fichier & "]" & Feuil2 & "'!"
        Formule form, col1, crit4, lig

        If trouve = 1 Then lig = lig + 1
        trouve = 0
    End If
Next
MsgBox Timer - t
End Sub

Sub Formule(form$, col%, crit$, lig&)
Dim f$, v
f = "MATCH(""" & crit & """," & form & "C" & col & ",0)"
v = ExecuteExcel4Macro(f)
If IsNumeric(v) Then
    trouve = 1
    Cells(lig, 1) = fichier 'retourne le nom du fichier
    If crit = crit1 Then Cells(lig, 2) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Véhicule
    If crit = crit2 Then Cells(lig, 3) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du Vin
    If crit = crit3 Then Cells(lig, 4) = ExecuteExcel4Macro(form & "R" & v & "C" & col + 1) 'retourne la valeur du BIN

    If crit = crit4 Then Cells(lig, 5) = ExecuteExcel4Macro(form & "R" & v & "C" & col) 'retourne la valeur de la trame 62 F0 29
End If
End Sub

Idem, prends de la ressource mémoire au fur et à mesure

Pas grave, je prends une macro de @dysorthographie qui fonctionne comme base et je modifie en fonction de mon besoin

MERCI à tous