Import selectif de données .txt

robysurfer

XLDnaute Nouveau
Bonjour,

L'entreprise dans laquelle je fais mon stage possède un template qui permet d'extraire les données d'un datalog en format .txt puis de les traiter dans un fichier excel.

Le soucis c'est que ces datalog font plusieurs Mo et donc l'importation sous excel marche mal.
On voudrait donc pouvoir importer les données dans le tableau excel de manière sélective sachant qu'une grosse partie des lignes ne nous intéressent pas.

Les datalogs ont cette forme:

Code:
DefectRecordSpec 15 DEFECTID XREL YREL XINDEX YINDEX XSIZE YSIZE DEFECTAREA DSIZE CLASSNUMBER TEST CLUSTERNUMBER ROUGHBINNUMBER FINEBINNUMBER REVIEWSAMPLE ;
DefectList
 1 6654.200 3168.500 2 -5 24.000 6.800 363.000 513.000 0 1 0 0 0 0
 2 2411.600 3717.500 1 -5 20.000 8.100 260.000 462.000 0 1 0 0 0 0
 3 7124.000 10381.500 0 -5 16.000 6.800 168.000 419.000 0 1 0 0 0 0

Ce que l'on voudrait c'est ne pas importer les lignes pour lesquelles "CLUSTERNUMBER" est différent de "0", à l'exception de la première de ces lignes (une ligne pour 1, une ligne pour 2 etc...).

Je ne connais rien ni en macro excel ni en basic, est-ce que quelqu'un possède un code de ce genre?

Merci beaucoup,

Robin
 

robysurfer

XLDnaute Nouveau
Re : Import selectif de données .txt

Importer puis supprimer à la main est la solution actuelle, mais:
-> L'importation bug le plus souvent à cause de la taille des .txt ( 100 000 ligne pour 4 Mo en moyenne)
-> La suppression à la main est très longue

Je joint le fichier excel qu'on souhaite améliorer avec la macro actuelle ("charger le fichier") et un datalog réel.

Robin
 

Pièces jointes

  • exemplel.zip
    228.4 KB · Affichages: 36
Dernière édition:

KenDev

XLDnaute Impliqué
Re : Import selectif de données .txt

Bonsoir à tous,

La sub suivante importe les 74 lignes utiles du fichier exemple (17271 lignes) quasi instantanément. Fichier joint.
VB:
Option Explicit

Const BFSpec As String = "DefectRecordSpec 15 DEFECTID XREL YREL XINDEX YINDEX XSIZE YSIZE DEFECTAREA DSIZE CLASSNUMBER TEST CLUSTERNUMBER ROUGHBINNUMBER FINEBINNUMBER REVIEWSAMPLE ;"

Sub Test()
Dim fn As Variant, TbFn$(), i&, ff%, s$, b As Boolean, TbLn$(), r&, Mx&, TbCn() As Boolean, bI As Boolean, j%, v%
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'sélection des fichiers 001 à traiter
    fn = Application.GetOpenFilename("Fichiers textes (*.001), *.001", , , , True)
    If TypeName(fn) = "Boolean" Then Exit Sub 'quitter si annuler
    'nouvelle feuille
    Sheets.Add
    'ligne de titre
    TbLn = Split(BFSpec, " "): r = 1
    For i = 2 To 16
        Cells(1, i - 1) = TbLn(i)
    Next i
    'fichiers à ouvrirs
    ReDim TbFn(1 To UBound(fn))
    'inicateur clusternumbermax
    Mx = 0
    'traitement
    For i = 1 To UBound(fn)
        TbFn(i) = fn(i) 'fichier en cours
        ff = FreeFile: b = False 'n° 'ouverture et non validation ligne de titre
        Open TbFn(i) For Input As #ff 'ouverture
            Do Until EOF(ff) 'tant que fin du fichier non atteinte
                Line Input #ff, s 'lire une ligne
                If Not b And s = BFSpec Then b = True 'validation ligne de titre
                If b Then
                    bI = False 'à priori on n'importe pas la ligne en cours
                    TbLn = Split(s, " ") 'tableau des champs
                    If UBound(TbLn) = 15 Then 'contrôles 16 champs (car fichier exemple commence par un espace)
                        If TbLn(12) = 0 Then 'test clusternumber
                            bI = True 'validation
                        Else
                            v = Val(TbLn(12)) 'clusternumber
                           If v > Mx Then 'ajuster tableau
                                Mx = v
                                ReDim Preserve TbCn(1 To Mx)
                           End If
                           If Not TbCn(v) Then '1ère occurence de ce clusternumber ?
                                TbCn(v) = True
                                bI = True 'validation
                           End If
                        End If
                    End If
                    'importation
                    If bI Then
                        r = r + 1
                        For j = 1 To 15
                            Cells(r, j) = TbLn(j)
                        Next j
                    End If
                End If
            Loop
        Close #ff 'fermeture
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Cordialement

KD
 

Pièces jointes

  • exemple_test.xls
    42 KB · Affichages: 39
  • exemple_test.xls
    42 KB · Affichages: 42
  • exemple_test.xls
    42 KB · Affichages: 43
Dernière édition:

Statistiques des forums

Discussions
312 216
Messages
2 086 351
Membres
103 195
dernier inscrit
martel.jg