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

[Kenza18]

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]

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]

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.

 

[chris]

RE

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

 

[Kenza18]

@chris, merci pour votre réponse mais vous pouvez modifier les nom de la colonnes c'est juste un exemple.

est ce que vous pouvez me dire s'il vous plait comment utiliser le powerQuery pour résoudre mon problème

 

[job75]

Bonjour Kenza18, R@chid, chris,

Téléchargez les fichiers zippés joints dans le même dossier et voyez la macro du bouton :

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+

 

[chris]

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]

bonjour a tous
@job75
la derniere ligne d'une colonne dans un fichier fermé

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]

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)

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 )

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]

re
je viens de tester ta méthode @job75 et ca ne fonctionne pas (sauf erreur de ma part )

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

 

[job75]

Salut patricktoulon,

je viens de tester ta méthode @job75 et ca ne fonctionne pas (sauf erreur de ma part )

Je suis étonné que tu ne saches pas que ExecuteExcel4Macro nécessite des références de Type R1C1.

Tu as mis D1 qui n'est pas la référence d'une colonne ! Mon code utilise C4 qui est l'adresse de la colonne D.

A+

 

[Kenza18]

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]

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]

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

 

[patricktoulon]

re
@job75
et purée !!oui tu a raison
je l'utilise pourtant souvent
j'ai été perturbé par la formule