XL 2010 Aide VBA pour extraire des infos d'un fichier TXT

Scal29

XLDnaute Nouveau
Bonjour,
J'ai un gros fichier txt avec des infos qui m'intéresses, pour une meilleur lisibilité je cherche à extraire ces résultats dans un fichier Excel
Comme du concret vaut mieux qu'un long discours, je joints 3 fichiers :
1 - Le fichier d'entrée avec mes données brutes
2 - La simplification que j'ai faite à la main
3 - Le fichier de sortie que j'aimerai bien avoir en automatique.
l'idéal serait un bouton qui me demanderai de sélectionner le fichier d'entrée et avoir le résultat en automatique.
Quelqu'un peut m'aider ?
Merci beaucoup d'avance
 

Pièces jointes

  • 1 - Fichier Entrée.txt
    10.5 KB · Affichages: 9
  • 2 - Fichier Sortie à la main.txt
    924 bytes · Affichages: 5
  • 3 - Fichier Sortie Souhaité.xlsx
    8.3 KB · Affichages: 7
Solution
Bonjour Scal,
Un essai en PJ avec ce que j'ai compris :
VB:
Sub Import()
    ' Array T contient toutes les données d'entrées, Array Tout les données de sorties
    Dim L&, Lout&, Ligne$, T, Tout, Datas, N&, objFSO, Données, NomFichier$, T0
    [A:D].ClearContents
    Application.ScreenUpdating = False
    ' Demande du choix de fichier à traiter
    NomFichier = Application.GetOpenFilename("Text files (*.txt*), *.txt*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
    If NomFichier = "Faux" Then Exit Sub                            ' Si "Annuleré on sort
    T0 = Timer  ' Init timer pour esure temps
    Const ForReading = 1
    Set objFSO = CreateObject("Scripting.FileSystemObject")         ' Création objet système
    Données =...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Scal,
Un essai en PJ avec ce que j'ai compris :
VB:
Sub Import()
    ' Array T contient toutes les données d'entrées, Array Tout les données de sorties
    Dim L&, Lout&, Ligne$, T, Tout, Datas, N&, objFSO, Données, NomFichier$, T0
    [A:D].ClearContents
    Application.ScreenUpdating = False
    ' Demande du choix de fichier à traiter
    NomFichier = Application.GetOpenFilename("Text files (*.txt*), *.txt*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
    If NomFichier = "Faux" Then Exit Sub                            ' Si "Annuleré on sort
    T0 = Timer  ' Init timer pour esure temps
    Const ForReading = 1
    Set objFSO = CreateObject("Scripting.FileSystemObject")         ' Création objet système
    Données = objFSO.OpenTextFile(NomFichier, ForReading).ReadAll   ' Données contient tout le fichier
    T = Split(Données, vbCrLf)                                      ' Séparation des lignes et mise en array
    N = UBound(T)                                                   ' Nombre de ligne de l'array
    Set objFSO = Nothing                                            ' Vidage mémoire
    ReDim Tout(N, 3): Lout = 0
    ' Le découpage se fait sur
    For L = 0 To N
        ' Si chaine contient Testing plot "INFO     Testing plot" pour la colonne A puis sur "Proofs" pour le reste
        If T(L) Like "*: INFO     Testing plot*" Then
            Datas = Split(Split(T(L), "\")(2), " ")(0)
            Tout(Lout, 0) = Datas
        ' Si chaine contient Proofs, à mettre sur la même ligne
        ElseIf T(L) Like "*Proofs*" Then
            Datas = Split(T(L), "Proofs")
            Tout(Lout, 1) = "Proofs"
            Datas = Split(Split(T(L), "Proofs")(1), ",")
            Tout(Lout, 2) = Datas(0)
            Tout(Lout, 3) = Datas(1)
            Lout = Lout + 1
        End If
    Next L
    ' Restitution du tableau dans la feuille
    Range("$A$1").Resize(UBound(Tout, 1), 4) = Tout
    Application.ScreenUpdating = True
    ' Message de sortie pour test, à supprimer si inutile
    Dim Texte$
    Texte = "Nom du fichier traité : " & NomFichier & Chr(10) & Chr(10)
    Texte = Texte & "Nombre de lignes en entrée : " & vbTab & N & Chr(10)
    Texte = Texte & "Nombre de lignes en sortie : " & vbTab & Lout & Chr(10)
    Texte = Texte & "temps  de traitement : " & vbTab & vbTab & Round(1000 * (Timer - T0), 0) & "ms"
    MsgBox Texte
End Sub
Sur mon PC je met 1.8s pour traiter un fichier de 100k lignes, ce qui est correct :
1650691093397.png

Cette partie Msgbox peut être supprimée, elle n'est là que pour test.
 

Pièces jointes

  • 3 - Fichier Sortie Souhaité V2.xlsm
    19.5 KB · Affichages: 4
Dernière édition:

Scal29

XLDnaute Nouveau
Bonjour Scal,
Un essai en PJ avec ce que j'ai compris :
VB:
Sub Import()
    ' Array T contient toutes les données d'entrées, Array Tout les données de sorties
    Dim L&, Lout&, Ligne$, T, Tout, Datas, N&, objFSO, Données, NomFichier$, T0
    [A:D].ClearContents
    Application.ScreenUpdating = False
    ' Demande du choix de fichier à traiter
    NomFichier = Application.GetOpenFilename("Text files (*.txt*), *.txt*", , "CHOISSISSEZ LE FICHIER A TRAITER", , False)
    If NomFichier = "Faux" Then Exit Sub                            ' Si "Annuleré on sort
    T0 = Timer  ' Init timer pour esure temps
    Const ForReading = 1
    Set objFSO = CreateObject("Scripting.FileSystemObject")         ' Création objet système
    Données = objFSO.OpenTextFile(NomFichier, ForReading).ReadAll   ' Données contient tout le fichier
    T = Split(Données, vbCrLf)                                      ' Séparation des lignes et mise en array
    N = UBound(T)                                                   ' Nombre de ligne de l'array
    Set objFSO = Nothing                                            ' Vidage mémoire
    ReDim Tout(N, 3): Lout = 0
    ' Le découpage se fait sur
    For L = 0 To N
        ' Si chaine contient Testing plot "INFO     Testing plot" pour la colonne A puis sur "Proofs" pour le reste
        If T(L) Like "*: INFO     Testing plot*" Then
            Datas = Split(Split(T(L), "\")(2), " ")(0)
            Tout(Lout, 0) = Datas
        ' Si chaine contient Proofs, à mettre sur la même ligne
        ElseIf T(L) Like "*Proofs*" Then
            Datas = Split(T(L), "Proofs")
            Tout(Lout, 1) = "Proofs"
            Datas = Split(Split(T(L), "Proofs")(1), ",")
            Tout(Lout, 2) = Datas(0)
            Tout(Lout, 3) = Datas(1)
            Lout = Lout + 1
        End If
    Next L
    ' Restitution du tableau dans la feuille
    Range("$A$1").Resize(UBound(Tout, 1), 4) = Tout
    Application.ScreenUpdating = True
    ' Message de sortie pour test, à supprimer si inutile
    Dim Texte$
    Texte = "Nom du fichier traité : " & NomFichier & Chr(10) & Chr(10)
    Texte = Texte & "Nombre de lignes en entrée : " & vbTab & N & Chr(10)
    Texte = Texte & "Nombre de lignes en sortie : " & vbTab & Lout & Chr(10)
    Texte = Texte & "temps  de traitement : " & vbTab & vbTab & Round(1000 * (Timer - T0), 0) & "ms"
    MsgBox Texte
End Sub
Sur mon PC je met 1.8s pour traiter un fichier de 100k lignes, ce qui est correct :
Regarde la pièce jointe 1137623
Cette partie Msgbox peut être supprimée, elle n'est là que pour test.

Merci beaucoup Sylvanu !!!

Ton fichier marche au top.

Je vais essayer de décoder tout ça pour me faire la main.

MERCI MERCI MERCI
 

Discussions similaires

Statistiques des forums

Discussions
312 198
Messages
2 086 134
Membres
103 129
dernier inscrit
Atruc81500