Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2537 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Fractionner un fichier texte

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Fractionner un fichier texte

n°1654949
speedest
Posté le 08-12-2007 à 14:32:49  profilanswer
 

Bonjour,
 
Etant sous Office 2003 avec WXP SP2, je souhaiterais fractionner un fichier texte (en VBA Excel) qui est trop gros pour être importer dans une cellule.
 
Je m'explique :
 
le fichier texte est comme ceci :
"texte1 FIN texte2 FIN texte3 FIN (...)" en une seule ligne.
 
C'est un fichier de base de données en fait, il n'y a pas de séparateur.
Tout est d'affilée, avec un certains nombre de caracrtères pour chaque champs. (exemple "texte1" = "champs1 champs2 champs3" avec champs1: 50 caractères, champs2 = 20 caractères ..etc)
 
Et vu qu'ensuite je voudrais faire différents mid() sous VBA pour exploiter les différents champs de "texte1" ou "texte2" ..etc, j'ai tout d'abord dans un premier temps besoin de séparer le fichier original en trois (pour notre exemple, en vrai c'est en 1000),
 
de sorte à avoir dans la cellule (1,1) :"texte1 FIN"
cellule (2,1) :"texte2 FIN"
cellule (3,1) :"texte3 FIN"
(...)
 
le mot FIN existe bien dans le fichier texte, et aussi, la taille en nombre de caractères de texte1, texte2, et texte3, est la même (~15000 => c'est pour ça que tout ne rentre pas dans une cellule, car je dois avoir 1000 fois le texte, donc 1000*15000 caractères ça rentre pas dans une cellule)
 
mon niveau en VBA est bas/moyen, je connais quelques trucs mais je suis loin de connaître tout.
 
Merci pour votre aide

mood
Publicité
Posté le 08-12-2007 à 14:32:49  profilanswer
 

n°1655024
kiki29
Posté le 08-12-2007 à 18:35:01  profilanswer
 

Soir Bon
Un échantillon du fichier texte en question ne serait pas de trop
sinon à priori un Split sur FIN pour obteniir un tableau, mais pour en faire plus il faut un échantillon du fichier texte


Message édité par kiki29 le 08-12-2007 à 18:44:39
n°1655090
speedest
Posté le 08-12-2007 à 22:43:07  profilanswer
 

bien vu kiki, c'est la soluz qu'on m'a donné sur un autre forum.
 
Faut faire un SPLIT sur FIN.
 
Merci
 

n°1655150
kiki29
Posté le 09-12-2007 à 04:24:55  profilanswer
 

Malgré cela une réponse à ton probleme, tu as le choix entre 2 façons de disposer les données lues Lire1 et lire2.
Cependant le nb de caracteres par champ n'étant pas précisé , par défaut j'ai pris un espace comme séparateur
Cela sera surement à modifier en conséquence, mais vu l'absence d'infos pertinentes.
 
 


Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
 
Sub Tst()
Dim Fichier As Variant
    ChDrive "C"
    ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier txt (*.txt), *.txt" )
    If Fichier <> False Then Lire1 Fichier
    'If Fichier <> False Then Lire2 Fichier
End Sub
 
Private Sub Lire1(ByVal NomFichier As String)
Dim chaine As String
Dim Ar() As String, Ar2() As String
Dim i As Long, j As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Debut As Currency, Fin As Currency, Freq As Currency
Const Separateur As String * 3 = "FIN"
 
    QueryPerformanceCounter Debut
    Cells.Clear
    Application.ScreenUpdating = False
 
    Close
    NumFichier = FreeFile
 
    Open NomFichier For Input As #NumFichier
    Do While Not EOF(NumFichier)
        Line Input #NumFichier, chaine
    Loop
    Close #NumFichier
 
    chaine = Trim(chaine)
 
    iRow = 1: iCol = 1
 
    Ar = Split(chaine, Separateur)
    For i = LBound(Ar) To UBound(Ar)
        Ar2 = Split(Trim(Ar(i)), " " )
        For j = LBound(Ar2) To UBound(Ar2)
            Cells(iRow, iCol) = Ar2(j)
            iCol = iCol + 1
        Next j
        iCol = 1
        iRow = iRow + 1
    Next i
 
    Application.ScreenUpdating = True
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
 
    Application.StatusBar = Format((Fin - Debut) / Freq, "0.00 s" )
End Sub
 
Private Sub Lire2(ByVal NomFichier As String)
Dim chaine As String
Dim Ar() As String, Ar2() As String
Dim i As Long, j As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Debut As Currency, Fin As Currency, Freq As Currency
Const Separateur As String * 3 = "FIN"
 
    QueryPerformanceCounter Debut
    Cells.Clear
    Application.ScreenUpdating = False
 
    Close
    NumFichier = FreeFile
 
    Open NomFichier For Input As #NumFichier
    Do While Not EOF(NumFichier)
        Line Input #NumFichier, chaine
    Loop
    Close #NumFichier
 
    chaine = Trim(chaine)
 
    iRow = 1: iCol = 1
    Ar = Split(chaine, Separateur)
    For i = LBound(Ar) To UBound(Ar)
        Ar2 = Split(Trim(Ar(i)), " " )
        For j = LBound(Ar2) To UBound(Ar2)
            Cells(iRow, iCol) = Ar2(j)
            iRow = iRow + 1
        Next j
        iCol = iCol + 1
        iRow = 1
    Next i
 
    Application.ScreenUpdating = True
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
 
    Application.StatusBar = Format((Fin - Debut) / Freq, "0.00 s" )
End Sub


 
Ces modifs devraient être de ce genre dans les procédures Lire
avec sans doute l'emploi de Trim  


.....
Const Ch1 As Integer = ...
Const Ch2 As Integer = ...
Const Ch3 As Integer = ...
.....    
    Ar = Split(chaine, Separateur)
    For i = LBound(Ar) To UBound(Ar)
        Cells(iRow, 1) = Left(Ar(i), Ch1)
        Cells(iRow, 2) = Mid(Ar(i), Ch1 + 1, Ch2)
        Cells(iRow, 3) = Right(Ar(i), Ch3)
        iRow = iRow + 1
    Next i
.....


Message édité par kiki29 le 09-12-2007 à 06:59:02
n°1655170
gzii
court-circuit
Posté le 09-12-2007 à 10:22:34  profilanswer
 

Puis attention aux modifs sur une chaîne déterminée.
Par exemple tu splites sur "FIN" puis dans le fichier on peut aussi trouver "FINLANDE" ou "AFFINAGE"...
 
Si ça vous fait rire, je constate souvent des dégâts de ce genre de traitements dans des fichiers que je reçois.
 
Si le fichier est en texte longueur fixe, le mieux est de le récupérer ainsi (avec un dessin d'enregistrement s'il est un peu complexe).
Sinon j'ai fait un petit prog qui m'ajoute juste le CRLF (retour chariot) à la longueur spécifiée (c'est tout con à faire).

n°1655268
speedest
Posté le 09-12-2007 à 14:43:23  profilanswer
 


Salut Gzii,
 

Citation :

Puis attention aux modifs sur une chaîne déterminée.
Par exemple tu splites sur "FIN" puis dans le fichier on peut aussi trouver "FINLANDE" ou "AFFINAGE"...


Tu as raison, faudra que je fasse attention à ça. J'affinerai en mettant peut-être d'autres caractères pour le split.
 

Citation :

Si le fichier est en texte longueur fixe, le mieux est de le récupérer ainsi (avec un dessin d'enregistrement s'il est un peu complexe).


Oui, texte longueur fixe, chaque chaîne concaténée a à peu près une longueur de 15 000 caractères. Et y'a 1000 chaînes, donc ça fait une ligne de 15 000 *1000 = 15 000 000 caractères.
 

Citation :

Sinon j'ai fait un petit prog qui m'ajoute juste le CRLF (retour chariot) à la longueur spécifiée (c'est tout con à faire).


Aurais-tu un petit exemple ?
 
merci,
à+

n°1655270
speedest
Posté le 09-12-2007 à 14:47:14  profilanswer
 

Avec le fichier texte "galak  confiserie1   pain seigle     4 563 FIN milka  confiserie2   pain blé        413 7 FIN choco  confiserie3   pain mie        7 3 58"
 
j'ai utilisé le code :
 

Citation :

Sub Test()
Dim Ligne$, Chemin$, NomFich$
Dim NoLigne As Long, NoCol As Integer, Tableau As Variant
Chemin = "E:\"
NomFich = "test.txt"
    Open Chemin & NomFich For Input As #1
    While Not EOF(1)
        Input #1, Ligne
    Wend
    Close #1
    Tableau = Split(Ligne, " FIN " )
     
    Long_champ = Array(8, 14, 16, 2, 2, 2)
         
    For NoLigne = 0 To UBound(Tableau)
        Long_tot = Long_champ(0)
        For NoCol = 1 To UBound(Long_champ) + 1
            Select Case NoCol
                Case 1
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), 1, Long_champ(NoCol - 1) - 1)
                Case 2
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1))
                Case 3
                    Long_tot = Long_tot + Long_champ(NoCol - 2)
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1))
                Case 4
                    Long_tot = Long_tot + Long_champ(NoCol - 2)
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1))
                Case 5
                    Long_tot = Long_tot + Long_champ(NoCol - 2)
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1))
                Case 6
                    Long_tot = Long_tot + Long_champ(NoCol - 2)
                    Cells(NoLigne + 1, NoCol).Value = Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1))
            End Select
        Next NoCol
     Next
End Sub


 
Et ça marche bien


Message édité par speedest le 09-12-2007 à 14:47:43
n°1655275
speedest
Posté le 09-12-2007 à 15:01:35  profilanswer
 

Citation :

Malgré cela une réponse à ton probleme, tu as le choix entre 2 façons de disposer les données lues Lire1 et lire2.
Cependant le nb de caracteres par champ n'étant pas précisé , par défaut j'ai pris un espace comme séparateur
Cela sera surement à modifier en conséquence, mais vu l'absence d'infos pertinentes.

 
 
Salut Kiki,
 
Ton code est de loin le plus abouti. Merci à toi.
Je l'ai testé et ça marche; plutôt le Lire2 d'ailleurs car avec le vrai fichier j'atteinds vite le nombre max de colonne en utilisant Lire1.
 
Reste que comme tu disais en agissant sur les espaces ça fait des choses non voulues.  
 
Faut donc que je m'y plonge dedans pour changer le séparateur espace en nombre de caractères (pour mon exemple de texte du post précédent : 8, 14, 16, 2, 2, 2 ).
 
merci,
à+


Message édité par speedest le 09-12-2007 à 15:02:21
n°1655335
kiki29
Posté le 09-12-2007 à 16:52:27  profilanswer
 

Si tu pouvais me zipper ton fichier texte (j'insiste lourdement ...) , je ne pense pas qu'il y ait des données confidentielles , le pb devrait être réglé rapidement


Message édité par kiki29 le 09-12-2007 à 17:26:28
n°1655338
speedest
Posté le 09-12-2007 à 17:13:47  profilanswer
 

En plus propre ça donne ça:
 

Citation :

Sub Test()
Dim Ligne$, Chemin$, NomFich$
Dim NoLigne As Long, NoCol As Integer, Tableau As Variant
Chemin = "E:\"
NomFich = "test.txt"
    Open Chemin & NomFich For Input As #1
    While Not EOF(1)
        Input #1, Ligne
    Wend
    Close #1
     
    Cells.Clear
    Tableau = Split(Ligne, " FIN " )
     
    Long_champ = Array(8, 14, 16, 2, 2, 2)
         
    For NoLigne = 0 To UBound(Tableau)
     
        Long_tot = Long_champ(0)
        NoCol = 1
        Cells(NoLigne + 1, NoCol).Value = Trim(Mid(Tableau(NoLigne), 1, Long_champ(NoCol - 1) - 1))
        NoCol = 2
        Cells(NoLigne + 1, NoCol).Value = Trim(Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1)))
         
        For NoCol = 3 To UBound(Long_champ) + 1
            Long_tot = Long_tot + Long_champ(NoCol - 2)
            Cells(NoLigne + 1, NoCol).Value = Trim(Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1)))
        Next
 
    Next
         
End Sub


Reste à voir la rapidité d'exécution quand y'aura une soixantaine de champs et 1000 chaînes.
 

Citation :

Si tu pouvais me zipper ton fichier texte (j'insiste lourdement ...) , je ne pense pas qu'il y ait des données confidentielles , le pb devrait être réglé rapidement : mail qui sera visible peu de temps phlh29 AT wanadoo POINT fr


 
Je t'envoie ça.


Message édité par speedest le 09-12-2007 à 21:58:18
mood
Publicité
Posté le 09-12-2007 à 17:13:47  profilanswer
 

n°1655523
speedest
Posté le 09-12-2007 à 22:49:25  profilanswer
 

Kiki,
 
Ton fichier est très abouti, merci.  
 

Citation :

Option Explicit
 
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
 
Sub Tst3()
Dim Fichier As Variant
    ChDrive "C"
    'ChDrive "E"
    'ChDir ThisWorkbook.Path
    Fichier = Application.GetOpenFilename("Fichier txt (*.txt), *.txt" )
    If Fichier <> False Then Lire3 Fichier
End Sub
 
Private Sub Lire3(ByVal NomFichier As String)
Dim Ligne As String
Dim NoLigne As Long, NoCol As Integer, Tableau() As String
Dim NumFichier As Integer
Dim Debut As Currency, Fin As Currency, Freq As Currency
Dim Long_champ() As Variant
Dim Long_tot As Integer
 
    QueryPerformanceCounter Debut
    Cells.Clear
    Application.ScreenUpdating = False
 
    Close
    NumFichier = FreeFile
 
    Open NomFichier For Input As #NumFichier
    Do While Not EOF(NumFichier)
        Line Input #NumFichier, Ligne
    Loop
    Close #NumFichier
     
    Tableau = Split(Ligne, " FIN " )
     
    Long_champ = Array(8, 14, 16, 2, 2, 2)
         
    For NoLigne = 0 To UBound(Tableau)
     
        Long_tot = Long_champ(0)
        NoCol = 1: Cells(NoLigne + 1, NoCol) = Trim(Mid(Tableau(NoLigne), 1, Long_champ(NoCol - 1) - 1))
        NoCol = 2: Cells(NoLigne + 1, NoCol) = Trim(Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1)))
         
        For NoCol = 3 To UBound(Long_champ) + 1
            Long_tot = Long_tot + Long_champ(NoCol - 2)
            Cells(NoLigne + 1, NoCol) = Trim(Mid(Tableau(NoLigne), Long_tot, Long_champ(NoCol - 1)))
        Next NoCol
 
    Next NoLigne
 
    Application.ScreenUpdating = True
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
 
    Application.StatusBar = Format((Fin - Debut) / Freq, "0.00 s" )
End Sub


 
 
Autrement je ne sais par quelle magie le 4 56 3 se transforme en 4 5 63 ??
 
As-tu enlevé l'espace du début de fichier texte ? ou est-ce que la façon d'ouvrir le fichier texte enlève cet espace ? car peut-être que ça vient de cet espace.
 
Les nombres devant sortir sont :
cells(1,4) = 4 cells(1,5) = 56 cells(1,6) = 3
cells(2,4) = 41 cells(2,5) = 3 cells(2,6) = 7
cells(33,4) = 7 cells(3,5) = 3 cells(3,6) = 58
 
et avec ton code, j'ai essayé de comprendre pourquoi, car on a la même partie principale, on obtient
cells(1,4) = 4 cells(1,5) = 5 cells(1,6) = 63
 
bizarre non ??


Message édité par speedest le 09-12-2007 à 23:50:15
n°1655565
kiki29
Posté le 09-12-2007 à 23:39:59  profilanswer
 

Soir Bon, peut être en insérant un Trim dans cette ligne

Code :
  1. Tableau = Split(Trim(Ligne), " FIN " )

n°1655570
speedest
Posté le 10-12-2007 à 00:02:48  profilanswer
 

Citation :

Soir Bon, peut être en insérant un Trim dans cette ligne
Code :
 
   1. Tableau = Split(Trim(Ligne), " FIN " )


 
C'est ça. Maintenant y'a les bon chiffres !


Message édité par speedest le 10-12-2007 à 00:03:03
n°1655779
gzii
court-circuit
Posté le 10-12-2007 à 12:46:42  profilanswer
 

speedest a écrit :


Aurais-tu un petit exemple ?


je n'en aurais pas eu en VB(A) car je ne connais pas.
 
Sinon ça aurait été :
 

  • Demander la longueur de l'enregistrement et la mettre dans n
  • Jusqu'à la fin du fichier 1 :
  • -- lire n octets dans le fichier 1
  • -- les écrire dans le fichier 2
  • -- écrire CRLF dans le fichier 2


Et bien sur on peut optimiser avec buffer du partiel ou de la totalité du fichier.

n°1657491
speedest
Posté le 13-12-2007 à 01:04:59  profilanswer
 

Bon les Mid(), ça a marché jusque vers la fin, mais sur la fin, ça part n'importe comment car y'a des caractères nuls, et avec Mid() ça n'est tout simplement plus possible.
 
Je vais donc utiliser un exemple que j'ai obtenu sur un autre forum, puisque ma base de données se structure de la même manière:
 
 

Citation :

Private Type article  ' voilà ma structure de la base de données
    ID As Long
    Name As String * 15
    prenom As String * 20
    age As Integer
End Type
 
Private Sub Command1_Click()
  'ici je crée quelques articles, juste pour en avoir  
 Dim mon_enregistrement As article, numenr As Long
   Open "d:\allons.txt" For Random As #1 Len = Len(mon_enregistrement)
    For numenr = 1 To 5
      mon_enregistrement.ID = numenr
      mon_enregistrement.Name = "article" & numenr
      mon_enregistrement.prenom = "coucou" & numenr
      mon_enregistrement.age = numenr * 3
      Put #1, numenr, mon_enregistrement
    Next numenr
  Close #1
End Sub  
 
Private Sub Command2_Click()
  ' et maintenant je vais les lire dans ma base de données  
  Dim mon_enregistrement As article, Position
  Open "d:\allons.txt" For Random As #1 Len = Len(mon_enregistrement)
    Position = 0
    Do While Not EOF(1)
      Position = Position + 1
      Get #1, Position, mon_enregistrement
      If mon_enregistrement.ID <> 0 Then MsgBox mon_enregistrement.ID & "  " & mon_enregistrement.Name & _
      "  " & mon_enregistrement.prenom & " " & mon_enregistrement.age
    Loop
  Close #1
End Sub


 
Seulement j'ai le problème de "Erreur de compilation, trop de variables locales non statiques"
et l'erreur pointe sur la ligne "Dim mon_enregistrement As article, Position" de Command2
Ca doit être dû au fait que j'ai beaucoup de champs et beaucoup de caractères pour les chaînes.
 
Savez-vous comment je pourrais faire pour lever ce problème ?  
 
merci


Message édité par speedest le 13-12-2007 à 01:10:27
n°1657493
kiki29
Posté le 13-12-2007 à 01:23:10  profilanswer
 

eh bien reste sur cet autre forum, car sans données réelles ..
D'ailleurs vas voir sur http://warin.developpez.com/access/fichiers/#LII-C


Message édité par kiki29 le 13-12-2007 à 01:54:57

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Fractionner un fichier texte

 

Sujets relatifs
Problème affichage du text dans un fichier après OpenTextFilecopie automatique de fichier
Zone d'édition de texte / Mode colones[BATCH] Selection du fichier le plus recent
Récupéré et stoquer dans un fichier log les URL visités[Résolu] Chat: bdd ou fichier?
java et fichier *.*[Oracle - Débutant] Exporter le résultat d'une requête dans un fichier
Lecture d'un fichier: fin de fichier arrive trop vite!htaccess > bloquer l'acces a un fichier sauf via un .swf
Plus de sujets relatifs à : Fractionner un fichier texte


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR