Discussion :

[Progeric]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
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

[tototiti2008]

Bonjour,

Peut-on voir à quoi ressemblent les 1ères lignes de tes données dans le fichier Liste NOI.xlsx feuille Rapport 1 (sans données confidentielles) ?

[Progeric]

Merci mais je viens d'avoir la solution sur un autre forum

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub Essai()
     Dim Arr, sRecherche, t, r
 
     t = Timer
     Arr = Array("C:\Users\e.finet1\Desktop\", "Liste NOI.xlsx", "Rapport 1")     '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

[deedolith]

Salut,

Mouais heu ...

Passe directement par Power Query.
C'est tout aussi efficace.