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

sylvanu à dit:

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.

Cliquez pour agrandir...

Scal29 à dit:

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

Cliquez pour agrandir...