Macro permettant d'Extraire des données a partir de fichiers textes

gibba88

XLDnaute Nouveau
Bonjour Bonne année 2014,
Avant de vous exposer mon probleme , je tenais a vous remercier d'avance pour votre participation.

Pour extraire des données à partir des fichiers texts et de les afficher sous excel( concaténation de donnés). j'ai crée une fonction qui me permettrais d'accéder au fichiers textes, de les selectionner, traiter et d'afficher leur données une apres l'autre sur une feuille excel.

La fonction marche partiellement, elle me permet de verifier le format des fichiers sélectionnés mais j'arrive pas a afficher les données de tous les fichiers sélectionnés.

Ci joint mon code , fichiers textes contenants les données a extraire , exemple d'affichage attendue (faite manuellement
Code:
Sub Select_fichier_QStat()
    Dim fn As Variant
    Dim i&
    Dim TbFn$(), ff%, s$
    Dim num1 As Integer
    Dim nim2 As Integer
    Dim diff As Integer
    Dim detect As Boolean
    Dim strCount As String
    '-----------------------------------
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'sélection des fichiers txt à traiter
    fn = Application.GetOpenFilename("Fichiers textes (*.txt), *.txt", , , , True)
    If TypeName(fn) = "Boolean" Then Exit Sub 'quitter si annuler
    'nouvelle feuille
    'Sheets.Add
    detect = True
    'fichiers à ouvrirs
    ReDim TbFn(1 To UBound(fn))
    'Traitement des fichiers
    For i = 1 To UBound(fn)
        TbFn(i) = fn(i) 'fichier en cours
        ff = FreeFile
        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 Left(s, 3) = "EV|" Then
                    'Controle sur le Event
                    'Nbre |
                    num1 = Len(s)
                    strCount = Replace(s, "|", "")
                    num2 = Len(strCount)
                    diff = num1 - num2
                    If diff = 35 Then
                        detect = True
                    Else
                        MsgBox "Erreur - Le champ EV contient " & diff & " | au lieu de 35"
                        detect = False
                    End If
                End If
                If Left(s, 3) = "ME|" Then
                    'Controle sur la mesure
                    'Nbre |
                     num1 = Len(s)
                     strCount = Replace(s, "|", "")
                     num2 = Len(strCount)
                     diff = num1 - num2
                     If diff = 19 Then
                        detect = True
                     Else
                        MsgBox "Erreur - Le champ ME contient " & diff & " | au lieu de 19"
                        detect = False
                     End If
                End If
                If Left(s, 3) = "TD|" Then
                    'Controle sur les limites
                    'Nbre |
                     num1 = Len(s)
                     strCount = Replace(s, "|", "")
                     num2 = Len(strCount)
                     diff = num1 - num2
                     If diff = 18 Then
                        detect = True
                     Else
                        MsgBox "Erreur - Le champ EV contient " & diff & " | au lieu de 18"
                        detect = False
                     End If
                End If
            Loop
        Close #ff 'fermeture
    Next i
    If detect = False Then
        MsgBox "Erreur - Une ou plusieurs lignes sont erronnées"
    Else
        MsgBox "Les Fichiers Qstat sont corrects !!"
    End If
    
    ' Affichage
    Dim cpt As Integer
    Dim Tableau() As String
    cpt = 1
    For cpt = 1 To UBound(fn)
        TbFn(cpt) = fn(cpt) 'fichier en cours
        If detect = True Then
            ff = FreeFile
            Worksheets("Feuil1").Select
            'Entete
            Cells(5, 1) = "Pas de Test"
            Cells(6, 1) = "Données Numérique"
            '---------------------
            
            'ouverture du fichier
            Open TbFn(cpt) For Input As ff
                While Not EOF(ff)
                    Line Input #ff, s
                    If Left(s, 3) = "ME|" Then
                        'on incrémente la ligne d'ecriture
                        cpt = cpt + 1
                        'on decompose
                        Tableau = Split(s, "|")
                        'on ecrit
                        Cells(5, cpt) = Tableau(4)
                        Cells(6, cpt) = Tableau(6)
                    End If
                Wend
            Close #ff
        End If
    Next cpt
End Sub
 

Pièces jointes

  • Extraction_finale_attendu.xlsx
    10.4 KB · Affichages: 55
  • Fichier_q_stat.zip
    1.2 KB · Affichages: 39

Paf

XLDnaute Barbatruc
Re : Macro permettant d'Extraire des données a partir de fichiers textes

bonjour,
dans la dernière boucle du code : For cpt = 1 To UBound(fn) on trouve un "compteur" incrémenté de façon à afficher les données dans des colonnes successives : cpt = cpt + 1

Le nom des variables étant identiques, on commence la boucle avec cpt=1, on passe dans la boucles, cpt est augmenté selon le nombre de ligne du fichier traité. Quand on refait la boucle pour une une deuxième itération, cpt au lieu de prendre la valeur 2 est déjà à 5 ou 6 ou 7 ou...

la solution, modifier le nom de la variable compteur ou de la variable de boucle.

Par ailleurs, une erreur dans les déclarations de variables :Dim nim2 As Integer au lieu de num2

Bonne suite
 
Dernière édition:

gibba88

XLDnaute Nouveau
Re : Macro permettant d'Extraire des données a partir de fichiers textes

bonjour,
dans la dernière boucle du code : For cpt = 1 To UBound(fn) on trouve un "compteur" incrémenté de façon à afficher les données dans des colonnes successives : cpt = cpt + 1

Le nom des variables étant identiques, on commence la boucle avec cpt=1, on passe dans la boucles, cpt est augmenté selon le nombre de ligne du fichier traité. Quand on refait la boucle pour une une deuxième itération, cpt au lieu de prendre la valeur 2 est déjà à 5 ou 6 ou 7 ou...

la solution, modifier le nom de la variable compteur ou de la variable de boucle.

Par ailleurs, une erreur dans les déclarations de variables :Dim nim2 As Integer au lieu de num2

Bonne suite

Bonjour , merci pour votre réponse,
J'ai modifier le cpt mais il m'affiche toujours la meme chose.
 

Paf

XLDnaute Barbatruc
Re : Macro permettant d'Extraire des données a partir de fichiers textes

re,

Chez moi, avec les documents fournis, le code initiale ne traite qu'un fichier, après modification du nom de variable il traite bien les trois.
pouvez vous mettre le code après modification?

A+
 

gibba88

XLDnaute Nouveau
Re : Macro permettant d'Extraire des données a partir de fichiers textes

re,

Chez moi, avec les documents fournis, le code initiale ne traite qu'un fichier, après modification du nom de variable il traite bien les trois.
pouvez vous mettre le code après modification?

A+

j'ai modifié le non ducompteur cpt en cpt1 dans la partie "affichage"

Code:
Sub Select_fichier_QStat()
    '------------------------------------'
    'Déclaration des variables           '
    '------------------------------------'
    Dim ft As Variant
    Dim i As Integer
    Dim TbFt(), ff%, s$
    Dim num1 As Integer
    Dim num2 As Integer
    Dim diff As Integer
    Dim detect As Boolean
    Dim strCount As String
    Dim cpt1, cpt As Integer
    
    '-----------------------------------
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    'sélection des fichiers texts à traiter
    ft = Application.GetOpenFilename("Fichiers textes (*.txt), *.txt", , , , True)
    If TypeName(ft) = "Boolean" Then Exit Sub 'quitter si annuler
    'nouvelle feuille
    'Sheets.Add
    detect = True
    'fichiers à ouvrirs
    ReDim TbFt(1 To UBound(ft))
    'Traitement des fichiers
    For i = 1 To UBound(ft)
        TbFt(i) = ft(i) 'fichier en cours
        ff = FreeFile
        Open TbFt(i) For Input As #ff 'ouverture
            Do Until EOF(ff) 'tant que la fin du fichier n'est pas atteinte
                Line Input #ff, s 'lire une ligne
                If Left(s, 3) = "EV|" Then
                    'Controle sur le Event
                    'Nbre |
                    num1 = Len(s)
                    strCount = Replace(s, "|", "")
                    num2 = Len(strCount)
                    diff = num1 - num2
                    If diff = 35 Then
                        detect = True
                    Else
                        MsgBox "Erreur !!- Un champ EV contient " & diff & " | au lieu de 35"
                        detect = False
                        Exit Sub
                    End If
                End If
                If Left(s, 3) = "ME|" Then
                    'Controle sur la mesure
                    'Nbre |
                     num1 = Len(s)
                     strCount = Replace(s, "|", "")
                     num2 = Len(strCount)
                     diff = num1 - num2
                     If diff = 19 Then
                        detect = True
                     Else
                        MsgBox "Erreur !!- Un champ ME contient " & diff & " | au lieu de 19"
                        detect = False
                        Exit Sub
                     End If
                End If
                If Left(s, 3) = "TD|" Then
                    'Controle sur les limites
                    'Nbre |
                     num1 = Len(s)
                     strCount = Replace(s, "|", "")
                     num2 = Len(strCount)
                     diff = num1 - num2
                     If diff = 18 Then
                        detect = True
                     Else
                        MsgBox "Erreur !! - Un champ TD contient " & diff & " | au lieu de 18"
                        detect = False
                        Exit Sub
                     End If
                End If
            Loop
        Close #ff 'fermeture
    Next i
    If detect = False Then
        MsgBox "Erreur !!- Une ou plusieurs lignes sont erronnées"
    Else
        MsgBox "Fichier(s) Qstat correct(s) "
    End If

' Affichage
    Dim cpt1, cpt As Integer
    cpt = 1
    cpt1 = 1
    For cpt1 = 1 To UBound(ft)
        TbFt(cpt) = ft(cpt) 'fichier en cours
        If detect = True Then
            ff = FreeFile
            Worksheets("Feuil1").Select
            'Entete
            Cells(5, 1) = "Pas de Test"
            Cells(6, 1) = "Données Numérique"
            'ouverture du fichier
            Open TbFt(cpt) For Input As ff
                While Not EOF(ff)
                    Line Input #ff, s
                    If Left(s, 3) = "ME|" Then
                        'on incrémente la ligne d'ecriture
                        cpt = cpt + 1
                        'on decompose
                        Tableau = Split(s, "|")
                        'on ecrit
                        Cells(5, cpt) = Tableau(4)
                        Cells(6, cpt) = Tableau(6)
                    End If
                Wend
            Close #ff
        End If
    Next cpt1
End sub
 

Paf

XLDnaute Barbatruc
Re : Macro permettant d'Extraire des données a partir de fichiers textes

il y a mélange des variables, l'une sert au niveau boucle d'indice de tableau, l'autre de compteur pour définir les colonnes d'affichage. Il faut changer le nom partout où il est utilisé.

La partie affichage devient avec cpt1 indice de boucle et de tableau, cpt compteur de colonne:


Code:
' Affichage
    Dim cpt1, cpt As Integer
    cpt = 1
 
    For cpt1 = 1 To UBound(ft)
        TbFt(cpt1) = ft(cpt1) 'fichier en cours
        If detect = True Then
            ff = FreeFile
            Worksheets("Feuil1").Select
            'Entete
            Cells(5, 1) = "Pas de Test"
            Cells(6, 1) = "Données Numérique"
            'ouverture du fichier
            Open TbFt(cpt1) For Input As ff
                While Not EOF(ff)
                    Line Input #ff, s
                    If Left(s, 3) = "ME|" Then
                        'on incrémente la ligne d'ecriture CE N'EST PAS LA LIGNE MAIS LA COLONNE
                        cpt = cpt + 1
                        'on decompose
                        Tableau = Split(s, "|")
                        'on ecrit
                        Cells(5, cpt) = Tableau(4)
                        Cells(6, cpt) = Tableau(6)
                    End If
                Wend
            Close #ff
        End If
    Next cpt1

Par ailleurs, dans Dim cpt1, cpt As Integer seul cpt est déclaré en integer, pour que les deux variables soient integer: Dim cpt1 As Integer, cpt As Integer
Mais ce n'est pas ce qui bloquait

Bon courage
 

gibba88

XLDnaute Nouveau
Re : Macro permettant d'Extraire des données a partir de fichiers textes

il y a mélange des variables, l'une sert au niveau boucle d'indice de tableau, l'autre de compteur pour définir les colonnes d'affichage. Il faut changer le nom partout où il est utilisé.

La partie affichage devient avec cpt1 indice de boucle et de tableau, cpt compteur de colonne:


Code:
' Affichage
    Dim cpt1, cpt As Integer
    cpt = 1
 
    For cpt1 = 1 To UBound(ft)
        TbFt(cpt1) = ft(cpt1) 'fichier en cours
        If detect = True Then
            ff = FreeFile
            Worksheets("Feuil1").Select
            'Entete
            Cells(5, 1) = "Pas de Test"
            Cells(6, 1) = "Données Numérique"
            'ouverture du fichier
            Open TbFt(cpt1) For Input As ff
                While Not EOF(ff)
                    Line Input #ff, s
                    If Left(s, 3) = "ME|" Then
                        'on incrémente la ligne d'ecriture CE N'EST PAS LA LIGNE MAIS LA COLONNE
                        cpt = cpt + 1
                        'on decompose
                        Tableau = Split(s, "|")
                        'on ecrit
                        Cells(5, cpt) = Tableau(4)
                        Cells(6, cpt) = Tableau(6)
                    End If
                Wend
            Close #ff
        End If
    Next cpt1

Par ailleurs, dans Dim cpt1, cpt As Integer seul cpt est déclaré en integer, pour que les deux variables soient integer: Dim cpt1 As Integer, cpt As Integer
Mais ce n'est pas ce qui bloquait

Bon courage

J'ai modifié comme tu m'as dis mais sa m'affiche toujour pareil.
C'est pas grave je vais me débrouiller .
Merci qu'a meme.
 

Discussions similaires

Réponses
19
Affichages
2 K