XL 2019 extraire des données d'un fichier Excel sans l'ouvrir avec VBA

Kenza18

XLDnaute Nouveau
Bonjour,

je souhaite extraire les données d'un fichier Excel très volumineux (lire le fichier sans l'ouvrir).

les données que je veux extraire sont les suivantes :

les cellules du champ code-techno == '4GF'. --> [ ce champ se trouve sur la colonne D]

Est ce que c'est possible de m'aider à trouver une solution avec VBA s'il vous plait ?

En vous remerciant d'avance pour vote aide.



Cordialement,
Kenza
 

R@chid

XLDnaute Barbatruc
Bonjour et Bienvenue sur XLD,
pourrais-tu joindre un fichier exemple sans données confidentielles? ça va nous aider à t'aider.
Je pense que l'on peut faire à l'aide du Power Query du fait que tu es sous Excel 2019, et ce bien sûr sans passer par du VBA.

Cordialement
 

Kenza18

XLDnaute Nouveau
Bonjour,

merci pour votre retour.

Voici en PJ un exemple mais je tiens à préciser que le fichier est très volumineux donc j'ai pris juste un petit extrait de mon fichier afin que vous puissiez comprendre le besoin.
 

Pièces jointes

  • Exemple.xlsx
    9.8 KB · Affichages: 37

chris

XLDnaute Barbatruc
RE

Pour modéliser en PowerQuery il faut au moins que les titres des colonnes correspondent ainsi que le nom de l’onglet
Extrait_PQ.jpg
 

job75

XLDnaute Barbatruc
Bonjour Kenza18, R@chid, chris,

Téléchargez les fichiers zippés joints dans le même dossier et voyez la macro du bouton :
VB:
Sub Importer()
Dim t#, chemin$, fichier$, dercol$, formule$, n&
t = Timer
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
dercol = "H" 'dernière colonne à copier
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "C4)") 'dernière cellule texte en colonne D
On Error GoTo 0
'---restitution---
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille de destination
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("A1:" & dercol & 1).Resize(n)
        .FormulaArray = "=" & formule & "A1:" & dercol & n 'formule de liaison matricielle
        .Value = .Value 'supprime la formule
       .Rows(1) .Offset(n).Resize(Rows.Count - n).ClearContents 'RAZ en dessous
        .Sort .Columns(4), Header:=xlYes 'tri pour regrouper et accélérer
        .Columns(4).Replace "4GF", "#N/A"
        On Error Resume Next
        .Columns(4).Offset(1).SpecialCells(xlCellTypeConstants, 3).EntireRow.Delete 'textes et nombres
        .Columns(4).Replace "#N/A", "4GF"
        .Replace 0, "", xlWhole 'efface les valeurs zéro
    End With
    With .UsedRange: End With 'actualise les barres de défilement
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub
Chez moi pour un fichier Source de 40 000 lignes la durée d'exécution est de 1,70 seconde.

A+
 

Pièces jointes

  • Dossier.zip
    953.6 KB · Affichages: 72
Dernière édition:

chris

XLDnaute Barbatruc
RE

Données, Obtenir des données, A partir d'un Fichier, A partir d'un classeur

sélectionner le fichier, sélectionner la feuille, puis Transformer les données: ce qui ouvre PowerQuery
  • Vérifier/corriger le typage automatique des données
  • Filtrer la colonne code_techno
  • sortir par Fermer et Charger, dans Tableau et indiquer l'emplacement voulu
Actualiser par Données, Actualiser tout si la source évolue
 

patricktoulon

XLDnaute Barbatruc
bonjour a tous
@job75
la derniere ligne d'une colonne dans un fichier fermé
VB:
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "C4)") 'dernière cellule texte en colonne D
On Error GoTo 0
je teste pas je te fait confiance
je connais la formule match"zzz" mais dans un fichier fermé par l'intermediaire d'une macro excel4 je n'y ai jamais pensé
Respect!!!! Monsieur🤯
 

patricktoulon

XLDnaute Barbatruc
re
sinon il y a Ado en sortie version variable tableau
je pèche la colonne D de "exemple.xlsx " et la met en A dans le fichier exécutif
possibilité de sauter les lignes vides !!!! (choisir la ligne)
VB:
Sub test_récup_plage()
    Dim fichier$, Tbl
    fichier = ThisWorkbook.Path & "\exemple.xlsx"    'à adapter
    Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, "D2:D100000", "Feuil1", False)
     Sheets("Feuil1").[A1].Resize(UBound(Tbl), 1) = Tbl
End Sub

Function GetcolumnValueOnClosedWbookskeepblank(fichier As String, RnG As String, Feuille As String, Optional headerTable As Boolean = False)
    Dim AdConn As Object, AdoComand As Object, HDR$, RsT As Object, RsTLigne&, RsTCol&, v$, Arr()
    Set AdConn = CreateObject("ADODB.Connection")
    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.RecordSet")
    HDR = Array("No", "Yes")(Abs(headerTable))
    AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"""
    AdoComand.ActiveConnection = AdConn
    AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    RsT.Open AdoComand, , 1, 3
    RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            'If Not IsNull(RsT.Fields(0).Value) Then  a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = RsT.Fields(0).Value'( débloquer si on veut sauter les vides)
            'ou
            a = a + 1: ReDim Preserve Arr(1 To a): Arr(a) = RsT.Fields(0).Value '(bloquer si on veux sauter les vides)
            If Not Arr(a) Like "*[A-z,:,€]*" Then
                If IsDate(Arr(a)) Then Arr(a) = Format(CDate(Arr(a)), "m/d/yyyy")
            Else
                Arr(a) = Replace(Arr(a), " €", "€")
            End If
            RsT.MoveNext
        Next
    Loop

    AdConn.Close: Set RsT = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
    GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function

ou directement en copie Ado (même résultat )
VB:
Sub testAdO()
    Dim fichier$, nomfeuille$, DispoCel As Range
    fichier = "C:\Users\polux\DeskTop\exemple.xlsx"
    nomfeuille = "feuil1"
    Set DispoCel = [A1]
    resADO [D2:D65535], fichier, nomfeuille, DispoCel
End Sub
Function resADO(plage, fichier, nomfeuille, destination)

'Dim Cn As ADODB.Connection, texte_SQL$, Rst As ADODB.Recordset
    Dim Cn As Object, texte_SQL$, Rst As Object
      Set Cn = CreateObject("ADODB.Connection")
     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
         texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & plage.Address(0, 0) & "]"  'la requête.    ' Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.
     Set Rst = CreateObject("ADODB.RecordSet")
    Set Rst = Cn.Execute(texte_SQL)
    destination.CopyFromRecordset Rst
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set Rst = Nothing
End Function
 

patricktoulon

XLDnaute Barbatruc
re
je viens de tester ta méthode @job75 et ca ne fonctionne pas (sauf erreur de ma part )
VB:
Sub test()
chemin = "C:\Users\polux\DeskTop\"
fichier = "Exemple.xlsx"
formule = "'" & chemin & "[" & fichier & "]Feuil1'!"
'On Error Resume Next
n = ExecuteExcel4Macro("MATCH(""zzz""," & formule & "D1)") 'dernière cellule texte en colonne D
'On Error GoTo 0
MsgBox n
End Sub
Capture.JPG
 

Kenza18

XLDnaute Nouveau
RE

Données, Obtenir des données, A partir d'un Fichier, A partir d'un classeur

sélectionner le fichier, sélectionner la feuille, puis Transformer les données: ce qui ouvre PowerQuery
  • Vérifier/corriger le typage automatique des données
  • Filtrer la colonne code_techno
  • sortir par Fermer et Charger, dans Tableau et indiquer l'emplacement voulu
Actualiser par Données, Actualiser tout si la source évolue


Merci beaucoup CHRIS
j'ai essayé d'utiliser le powerQuery et ça fonctionne super bien par contre à la fin du traitement je ne veux pas le charger le résultat dans un tableau Excel comme le fichier est très volumineux ça prend énormément du temp.
est ce qu'il y a un moyen d'enregistrer le résultat sans le charger?
 

chris

XLDnaute Barbatruc
RE

Très volumineux mais plus précisément ?

Sur le fichier de 40000 ligne de job75, c'est instantané mais j'imagine que tu as plus de colonnes et de lignes.

Une requête n'est qu'une question mais seul le chargement en récupère le résultat.
Cela peut être récupérer dans un TCD éventuellement : tout dépend de ce que tu cherches concrètement à obtenir
 

Kenza18

XLDnaute Nouveau
RE

Très volumineux mais plus précisément ?

Sur le fichier de 40000 ligne de job75, c'est instantané mais j'imagine que tu as plus de colonnes et de lignes.

Une requête n'est qu'une question mais seul le chargement en récupère le résultat.
Cela peut être récupérer dans un TCD éventuellement : tout dépend de ce que tu cherches concrètement à obtenir


environ 31000000 lignes

je veux récupérer toutes mes données avec le filtre 4GF
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly