Recherche verticale dans un fichier fermé

Bonjour,

J'ai un énorme problème, même ChatGPT n'y arrive pas.

J'ai un fichier Excel de 25MO avec une feuille "Rapport 1", 864076 lignes et 3 colonnes

Je sais faire une recherche verticale en VBA si j'ouvre le fichier mais l'ouverture prend du temps, trop de temps.

Alors j'ai chercher sur internet comment faire et il y a deux réponses

- Rechercher une ligne avec QueryTable

- Rechercher une ligne avec ADO

Mais voilà l'une comme l'autre cela ne fonctionne pas et cela viendrait de la requête SQL.

Le but est que selon la valeur je trouve la ligne dans le fichier Liste NOI et la copie dans mon fichier Excel dans la feuille Base NOI

Si vous avez une autre technique sans ouvrir le fichier, je suis preneur.

Dans le code qui suit j'ai essayé de remplacer WHERE F1 par WHERE [A] ou WHERE [A1] et même WHERE Noi en ayant nommé la colonne A "Noi" mais rien n'y fait il ne trouve aucune valeur.

Merci pour votre aide

Sub RechercheLigneAvecQueryTable3()
    Dim xlSheet As Worksheet
    Dim cheminFichier As String
    Dim rechercheValeur As String
    Dim qt As QueryTable
    Dim requeteSQL As String

    ' Définir la valeur à rechercher
    rechercheValeur = Cells(4, 13).Value

    ' Définir le chemin du fichier Excel fermé
    cheminFichier = "C:\Users\e.finet1\Desktop\Liste NOI.xlsx"

    ' Référence à la feuille de travail où vous voulez importer la ligne
    Set xlSheet = ThisWorkbook.Sheets("Base NOI")

    ' Construire la requête SQL pour rechercher la valeur dans la colonne A (F1)
    requeteSQL = "SELECT * FROM [Rapport 1$] WHERE F1 = '" & rechercheValeur & "'"

    ' Créer un QueryTable avec la requête SQL
    On Error Resume Next
    Set qt = xlSheet.QueryTables.Add(Connection:="OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & cheminFichier & ";Extended Properties=""Excel 12.0;HDR=YES;"";", Destination:=xlSheet.Range("A22043"))
    On Error GoTo 0

    ' Spécifier la requête SQL
    qt.CommandText = requeteSQL

    ' Actualiser le QueryTable (exécuter la requête)
    On Error Resume Next
    qt.Refresh BackgroundQuery:=False
    On Error GoTo 0

    ' Vérifier si des données ont été importées
    If xlSheet.Cells(22043, 1).Value = "" Then
        MsgBox "Aucune donnée trouvée"
    Else
        MsgBox "Données trouvées et importées avec succès."
    End If

    ' Supprimer le QueryTable pour nettoyer
    qt.Delete
End Sub

un essai

Sub Essai()
     Dim Arr, sRecherche, t, r

     t = Timer
     Arr = Array("C:\Users\e.finet1\Desktop\", "Liste NOI.xlsx", "Base NOI")     'chemin, nom fichier, feuille
     sRecherche = "XYZ"                      'ce que vous voulez trouver
     Set c = Range("A10")                    'copier ce que vous trouvez dans cette plage du fichier actuel

     With GetObject(Arr(0) & Arr(1))         'ouvrir sans ouvrir
          i = Application.IfError(Application.Match(sRecherche, .Sheets(Arr(2)).Columns(1), 0), "?")     'recherche
          If IsNumeric(i) Then
               c.Resize(, 10).Value = .Sheets(Arr(2)).Cells(i, 2).Resize(, 10).Value     'si trouvé ...
          Else
               MsgBox "désolé"
          End If
          .Close 0
     End With

     MsgBox Timer - t & vbLf & "Ligne : " & i
End Sub

Merci cela fonctionne parfaitement

Il faut juste changer "Base NOI" par "Rapport 1",

"Base NOI" étant la feuille dans laquelle je mettrai mon importation et "Rapport 1" celle ou je vais chercher les informations

Encore Merci

re,

la réponse, vous l'avez dans combien de temps ?

J'ai fait le test sur un petit fichier. Je ferai le test en réel demain à mon travail. Je posterai alors le temps. Sinon sur mon test la reponse etait en 0,125.

Encore merci

Bonjour,

Il faut entre 9 et 8 secondes pour trouver le numéro de ligne recherchée parmi les 864076.

Passez une bonne journée.

re,

oei, chez moi avec un fichier vide sauf pour la cellule A1000000 qui contient la valeur recherchée, c'était 2.6 sec. Votre query, c'était combien de temps ?

C'est un peu tricher, on ouvre ce fichier en "arrière-plan", donc cela ne se voit pas, on fait son truc et puis on ferme le fichier sans sauvegarder.

Ceci est sans ouvrir et dure 8 sec chez moi, donc je suppose que cela sera au minimum le double chez vous (il faut avoir une feuille "Brouillon" ou modifier le code) :

Sub Progeric()
     Dim Arr, sRecherche, r, t

     t = Timer
     Arr = Array("C:\Users\e.finet1\Desktop\", "Liste NOI.xlsx", "Rapport 1")     'chemin, nom fichier, feuille
     'Arr = Array("C:\Users\Eigenaar\Downloads\", "xyzabc.xlsx", "Blad1")     'mon array !!!!!!!!!!
     sRecherche = "leen"                     'ce que vous voulez trouver

     With Sheets("Brouillon")                'une feuille dans laquelle on peut utiliser une colonne complète
          With .Columns("A")
               On Error Resume Next
               ThisWorkbook.Names("Plage").Delete
               ThisWorkbook.Names("Plage2").Delete
               On Error GoTo 0
               ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Arr(0) & "[" & Arr(1) & "]" & Arr(2) & "'!$A:$A"
               .Value = "=Plage"
               r = Application.Match(sRecherche, .Offset(0), 0)
               .ClearContents
          End With

          If IsNumeric(r) Then
               ThisWorkbook.Names.Add "Plage2", RefersTo:="='" & Arr(0) & "[" & Arr(1) & "]" & Arr(2) & "'!$A" & r & ":$Z" & r
               With .Range("A1:Z1")
                    .Value = "=Plage2"
                    .Value = .Value
               End With
          End If
     End With

     MsgBox Timer - t & vbLf
     MsgBox r
End Sub

Hello,

Pour info, (après construction d'un fichier de 650 000 lignes, 3 colonnes, 19Mo)

Recherche de 20 NOI (ou plus, ou moins) en quelques secondes...(NOI : Numéro OTAN d'Identification en 9 chiffres?)

- 8 à 9 secondes lors de l'ouverture du fichier + 1ère recherche (ouverture de la connexion entre le fichier de recherche et la base - donc sans ouverture de la base)

- Puis 5 à 6 secondes, tant que la connexion est effective

Par le biais de PQ, alias Power Query, nativement installé depuis la version 2016, donc disponible dans ta version

re, salut Cousinhub,

pour m'amuser, j'ai fait le teste avec 5 valeurs à rechercher.

• Ma première méthode de hier avec "GetObject" durait 7 sec pour la première valeur et puis 0.1 sec pour les valeurs suivantes.
• L'autre (avec des plages nommées) durait 14 sec pour la première valeur et puis 10 sec pour les valeurs suivantes.

Donc le gagneur est ...