Supprimer une ligne blanche lors de la fusion de fichiers .txt (VBA)

**paqmarc** · 19/04/2018, 15h07

Bonjour,
Cela ne change rien, mon Line Input #x1, DataLine lit parfois une seulement valeur ou parfois toutes les valeurs d'un bloc (comme si elles étaient toutes sur la même ligne). C!est pour cela que mon compteur de cassettes affiche parfois le bon nombre de cassettes et parfois le nombre de fichiers à la place. Pourtant, si j'ouvre chacun des fichiers csv, les cassettes de mes 4 fichiers sont dans la même colonne et non sur une ligne...

Merci de votre aide..

**patricktoulon** · 19/04/2018, 16h44

re
dans ce cas la c'est pas du a la macro mais au format du fichier text

**RyuAutodidacte** · 20/04/2018, 07h28

Bonjour,

Dites moi si je me trompe ou pas;

Pourquoi ne pas procéder ainsi :

- Création d'une variable texte/String Globale (Taille Variable) permettant de regrouper l'ensemble des fichiers

- donc à chaque ouverture de fichiers on l'insère dans : MaVarTxtGlobale = MaVarTxtGlobale & LireFichierTexte(Chemin & Fichier) & vbCrLf

- une fois tous les fichiers ajoutés, on passe cette variable par le Regex

- Pour Récupérer CptK7 (A voir car je connais pas les fichiers) utilisation d'un Split sur la variable MaVarTxtGlobale

- On injecte au final MaVarTxtGlobale dans le fichier final que l'on enregistre sous le nom voulu

Procédure terminée :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub RegroupeFichiers()
Dim Chemin$, Fichier$, MaVarTxtGlobale$
 
    Chemin = "C:\Users\NomUser\Documents\Fichiers Excel\Regroupe Fch TXT\TXT\"
    Fichier = Dir(Chemin & "*.txt")  ' ou "*.cvs"
    MaVarTxtGlobale = ""
 
    Do While Len(Fichier) > 0
 
        On Error Resume Next
        MaVarTxtGlobale = MaVarTxtGlobale & LireFichierTexte(Chemin & Fichier) & vbCrLf 'appelle la fonction "LireFichierTexte"
        If Err Then MsgBox "Le fichier n'a pas pu être lu...": Err.Clear
 
        Fichier = Dir()
    Loop
 
Dim regex As Object, CptK7&
 
    Set regex = CreateObject("VBScript.RegExp")
    With regex
      .Pattern = "^\s*(\n|\r)$"
      .Global = True
      .MultiLine = True
    End With
    MaVarTxtGlobale = regex.Replace(MaVarTxtGlobale, "")
 
    'CptK7 = UBound(Split(MaVarTxtGlobale, Chr(10))) + 1 => selon ce l'on veut cibler (avec ou sans en-tête)
 
    MaVarTxtGlobale = Mid("SGA" & UCase(Format(Weekday(Now), "ddd")), 1, 6) & vbCrLf & MaVarTxtGlobale
    Debug.Print MaVarTxtGlobale
 
    CptK7 = UBound(Split(MaVarTxtGlobale, Chr(10))) + 1
 
    MsgBox "Nombre de lignes avec l'en-tête comprise :" & vbCrLf & CptK7
 
    'Mettre ici le code pour enregistrer le texte dans le fichier final via la variable MaVarTxtGlobale 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Function LireFichierTexte(ByVal MonFichier As String) As String
'par: http://excel-malin.com
 
    On Error GoTo LireFichierTexteErreur
    Dim IndexFichier As Integer
    IndexFichier = FreeFile()
    Open MonFichier For Binary Access Read As #IndexFichier
    LireFichierTexte = Space$(LOF(IndexFichier))
    Get #IndexFichier, , LireFichierTexte
    Close #IndexFichier
 
    Exit Function
LireFichierTexteErreur:
    Close #IndexFichier
    LireFichierTexte = ""
End Function

Alors ... ??

Edit : À adapter bien sûr si cela convient …

**patricktoulon** · 20/04/2018, 09h17

re
Bonjour Ryu

Pourquoi ne pas procéder ainsi :

- Création d'une variable texte/String Globale (Taille Variable) permettant de regrouper l'ensemble des fichiers

allons t' en a pas une une idée du pourquoi ?

essaie de faire ca avec des fichier contenant des milier de lignes

**RyuAutodidacte** · 20/04/2018, 09h46

Salut Patrick,

Si tu peux donner plus de détails se serait un plus

Ce que je sais, avec le terminal de OS X (Mac), on peut supprimer des milliers de lignes assez facilement,
via une commande grep, awk et même sed permettant de supprimer les lignes vides et de connaître le nombre de lignes …

Ex : sur un fichier texte comprenant plus de 80000 lignes je fais une suppression de tous les chemins : ayant "._"
sed -i '' '/\.\_/d' RESULTAT3.txt
ça prends même pas 2 secondes

**patricktoulon** · 20/04/2018, 10h01

re
Detail??
ma fois dans windows une variable string ne peut contenir que un peu plus de 32 000 caracteres forcement a un moment donné ca va planter
c'est pour cela que j'ai proposer au demandeur de lire le fichier texte ligne par ligne plutot

un fichier de 1000 ligne avec 33 cararcteres par lignes et c'est mort

**pijaku** · 20/04/2018, 11h21

Bonjour,

Patrick,
Ne confonds tu pas avec le nombre de caractères maxi que peux afficher une cellule Excel?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub Demo()
Dim s As String
   s = String(258244589, "A")
   Debug.Print Left(s, 10) & " ... " & Right(s, 10) & " Longueur : " & Len(s)
End Sub

EDIT : https://silkyroad.developpez.com/VBA...riables/#LII-I

**RyuAutodidacte** · 20/04/2018, 13h46

Salut Franck,

en plus je rejoins Franck pourquoi ne pas lire le fichier en une fois

surtout que l'on ne connait pas + ou - le nb de caractères par lignes et le nb de lignes dans un fichier
=> si @paqmarc peut nous éclairer, il me semble pas avoir vu l'information (ou je l'ai zappé alors)

• Patrick j'ai repris mon fichier avec les liens pour tester un variable texte/string
Nombre de lignes 67801 avec + ou - 143 caractères/ligne => 9 695 543 caratères

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub toto()
Dim txt$, VA, VB
VA = Range("A1").CurrentRegion.Value
ReDim VB(1 To UBound(VA))
For i = 1 To UBound(VA)
    VB(i) = VA(i, 1)
Next
txt = Join(VB, vbCrLf)
Debug.Print txt
End Sub

ca passe très bien et rapidement

**patricktoulon** · 20/04/2018, 16h19

re
j'ai des fichier ".txt" entre 4 et 8 mega ca te donne une idée du contenu et cela il ne passe pas
c'est enterme d'octets qu'il faut compter
bref je vous laisse decouvrir pourquoi bien que je l'ai deja mentionné dans le post pourquoi je ne stokais pas

**RyuAutodidacte** · 20/04/2018, 18h22

Re,

J'ai testé un fichier de 8,7 méga sur Mac et celui-ci est passé,
Je testerai sur PC pour voir comment cela réagit en passant 3-4 fichiers plus ou moins de la même taille.

**pijaku** · 20/04/2018, 19h58

Envoyé par patricktoulon

re
j'ai des fichier ".txt" entre 4 et 8 mega ca te donne une idée du contenu et cela il ne passe pas
c'est en terme d'octets qu'il faut compter

A ton avis combien "pèse", en octets, un fichier txt de 200 000 000 de caractères?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Dim s As String, ff As Integer
 
Sub t()
s = String(200000000, "A")
ff = FreeFile
Open "C:\Users\" & Environ("username") & "\Desktop\output.txt" For Output As #ff
    Print #ff, s
Close #ff
End Sub
 
Sub n()
ff = FreeFile
Open "C:\Users\" & Environ("username") & "\Desktop\output.txt" For Input As #ff
    s = Input(LOF(1), #ff)
Close #ff
Debug.Print Len(s)
End Sub

**RyuAutodidacte** · 20/04/2018, 23h18

Re,

J'ai fait les tests sur PC avec du texte brut - 3 fichiers :
Nom : Capture FchTxt.PNG
Affichages : 245
Taille : 5,9 Ko

j'y ai mis qq lignes vide dans chaque fichiers pour jouer le jeu
Nom : Vid1.gif
Affichages : 289
Taille : 498,2 Ko

Je pense que cela marche parfaitement et quasi 194 000 lignes c'est déjà pas mal

Edit : Au fait Patrick, je n'ai eu aucun plantage ... et c'est très rapide

Edit 2 : j'ai continuer sur ma lancé - faut dire que j'en fais jamais du code avec la lecture/écriture de fichier texte,
donc si vous voyez des lignes à arranger où pas exactement dans le bon ordre concernant les gestions d'erreurs ou autres ..., n'hésiter pas

Le résultat :
Nom : Capture FchTxtFinal.PNG
Affichages : 251
Taille : 7,9 Ko

le code compléter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub RegroupeFichiers()
Dim Chemin$, Fichier$, MaVarTxtGlobale$
 
    Chemin = "C:\Users\NomUser\Documents\Fichiers Excel\Regroupe Fch TXT\TXT2\"
    Fichier = Dir(Chemin & "*.txt")  ' ou "*.cvs"
    MaVarTxtGlobale = ""
 
    On Error Resume Next
    Do While Len(Fichier) > 0
        MaVarTxtGlobale = MaVarTxtGlobale & LireFichierTexte(Chemin & Fichier) & vbCrLf 'appelle la fonction "LireFichierTexte"
        If Err Then MsgBox "Le fichier n'a pas pu être lu...": Err.Clear
 
        Fichier = Dir()
    Loop
    On Error GoTo 0
 
Dim regex As Object, CptK7&
 
    Set regex = CreateObject("VBScript.RegExp")
    With regex
      .Pattern = "^\s*(\n|\r)$"
      .Global = True
      .MultiLine = True
    End With
 
    MaVarTxtGlobale = Mid("SGA" & UCase(Format(Weekday(Now), "ddd")), 1, 6) & vbCrLf & MaVarTxtGlobale
    MaVarTxtGlobale = regex.Replace(MaVarTxtGlobale, "")
 
    'CptK7 = UBound(Split(MaVarTxtGlobale, Chr(10))) + 1 => selon ce l'on veut cibler (avec ou sans en-tête)
 
    Debug.Print MaVarTxtGlobale
 
    CptK7 = UBound(Split(MaVarTxtGlobale, Chr(10))) + 1
 
    MsgBox "Nombre de lignes avec l'en-tête comprise :" & vbCrLf & CptK7
    VA = Split(MaVarTxtGlobale, Chr(10))                'Ligne à supprimer - sert pour les tests
    ReDim VB(0 To UBound(VA), 1 To 1)                'Ligne à supprimer - sert pour les tests
    For i = 0 To UBound(VA)                            'Ligne à supprimer - sert pour les tests
        VB(i, 1) = VA(i)                                'Ligne à supprimer - sert pour les tests
    Next                                              'Ligne à supprimer - sert pour les tests
    Cells(1, 3).Resize(UBound(VA) + 1, 1).Value = VB   'Ligne à supprimer - sert pour les tests
 
Dim F As Integer, FichierFinal$
    On Error Resume Next
    If Not Err Then
        F = FreeFile
        FichierFinal = "C:\Users\NomUser\Documents\Fichiers Excel\Regroupe Fch TXT\TXT2\FchFinal.txt"
        Open FichierFinal For Output As #F
        Print #F, MaVarTxtGlobale
        Close #F
    Else
        MsgBox "Une erreur est survenue..."
    End If
 
    On Error GoTo 0
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Function LireFichierTexte(ByVal MonFichier As String) As String
'par: http://excel-malin.com
 
    On Error GoTo LireFichierTexteErreur
    Dim IndexFichier As Integer
    IndexFichier = FreeFile()
    Open MonFichier For Binary Access Read As #IndexFichier
    LireFichierTexte = Space$(LOF(IndexFichier))
    Get #IndexFichier, , LireFichierTexte
    Close #IndexFichier
 
    Exit Function
LireFichierTexteErreur:
    Close #IndexFichier
    LireFichierTexte = ""
End Function

C'est passé comme une lettre à la poste ...

**patricktoulon** · 21/04/2018, 00h39

tu tourne sur quoi la ryu?
désolé chez moi windows 7 excel2007 plantage du lof

**RyuAutodidacte** · 21/04/2018, 00h45

Ha c'est vrai les versions de windows et d'excel qui peut être diverses …
PS : si la variable MaVarTxtGlobale est OK sur Excel 2007, alors garder le tableau VA et boucler dessus pour écrire ligne par ligne dans ce cas …

Sur mon Mac

j'ai une partition de démarrage sous Windows 10 et j'ai Excel 2010 - Ram 8 Go

En effet je ne peux pas tester sur Excel 2007

**unparia** · 21/04/2018, 07h58

Bonjour
Je rappelle mon message 38 (qui remonte à 20 jours)

Je rappelle l'existence de la fonction Input (à ne pas confondre avec l'instruction Input #) qui permet de lire bloc par bloc (de caractères) si on le souhaite

1) cette lecture par bloc (de la taille de votre choix) permet de lire, bloc par bloc, les fichiers textes les plus énormes.
2) l'utilisation de cette même fonction permet de lire d'emblée, si on le souhaite, les deux derniers caractères d'un fichier
3) pour assurer la fusion de deux fichiers, il suffit dès lors d'utiliser la méthode Append de la manière suivante :
a) ajouter (d'un coup ou bloc par bloc comme vu en 2) les données de fichier1
b) si les deux derniers caractères de fichier1 ne sont pas vbcrlf, ajouter un saut de ligne
c) ajouter (d'un coup ou bloc par bloc comme vu en 2) les données de fichier2
Il s'agit vraiment là de ce qu'il y a de plus simple à mettre en oeuvre.

**Promethee25** · 21/04/2018, 09h04

Bonjour,

On peut effectivement stocker jusqu'à deux milliards de caractères dans une variable string en théorie mais la limite pratique peut être inférieure si la RAM disponible n'est pas suffisante.
Dans ce cas la macro pourra fonctionner sur un PC ayant beaucoup de RAM dispo et crasher sur un PC en ayant moins. (c'est du vécu: j'avais un (très très) gros fichier texte que je voulais charger en une fois dans une string pour y appliquer des expressions régulières et ça fonctionnait bien sur un PC mais pas sur l'autre).

**patricktoulon** · 21/04/2018, 10h12

Merci prométhee

perso j'ai 32 G ram 24 exploitable windows7 64 premium excel2007 et il arrive parfois que ca plante
c'est pour cela que j'ai conseiller des le depart de lire les fichiers ligne par ligne et de les retranscrire imediatement les fichier base et le final etant tout deux ouvert l'un en lecture l'autre en ecriture "APPEND !!"
un print# x fois n'est pas plus lent que print# un gros texte voir meme plus rapide car il n'y a pas de surcharge memoire surtout dans une boucle X fichiers , donc aucun risque de plantage de ce coté la
j'ai fait des tests sur des gros fichiers

Ryu il me semble avoir vu dans une de tes capture que tu passe par un sheet avec cette methode ca m'etonnerait fortement que se soit plus rapide

et combien meme perdre quelque centiemes de seconde et avoir une securité totale : a choisir perso vous connaissez ma reponse

**patricktoulon** · 21/04/2018, 10h24

lit parfois une seulement valeur ou parfois toutes les valeurs d'un bloc (comme si elles étaient toutes sur la même ligne).

je te l'ai deja dit paqmarc ca n'est pas du au code mais au formatage du fichier texte

pour verifier ce que je te dis ouvre ton fichier concerné avec notpad + (gratuit)

**RyuAutodidacte** · 21/04/2018, 10h52

Re,

Ryu il me semble avoir vu dans une de tes capture que tu passe par un sheet avec cette methode ca m'etonnerait fortement que se soit plus rapide

non du tout je c'étais juste pour la démo, je passe directement via la variable string que j'injecte - cf. code

Concernant la Ram j'ai fait un Maj de post :

Envoyé par RyuAutodidacte

Sur mon Mac

j'ai une partition de démarrage sous Windows 10 et j'ai Excel 2010 - Ram 8 Go

Je suis loin des 32 Go de Ram que tu as …

Edit : https://bettersolutions.com/vba/func...t-function.htm

**unparia** · 21/04/2018, 13h18

Bon
J'ai apparemment prêché dans le désert deux fois (voir plus haut).
C'est du code, qu'il faut ? --->> Allons-y
1) première considération : obtenir une fusion de fichiers ne signifie pas forcément en dénaturer un.
On peut fort bien vouloir ce résultat, mais conserver les fichiers tels qu'ils étaient.
Et rien n'interdit, si on le souhaite par ailleurs, de détruire les fichiers originels.
2) Que veut-on ?
- Réunir plusieurs fichiers texte et "réparer" leur erreur éventuelle d'écriture (en supprimant dans le résultat final le saut de ligne malencontreusement écrit) ?
- pouvoir le faire autrement que ligne par ligne (par blocs d'octets , donc) ? (notamment pour le cas où fichiers E N N O O O R M M E S )
J'en ai indiqué la méthode deux fois (plus haut) -->> son code ? --->> le voici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim fics, desti As String, n As Integer, lgt As Long, lgb As Long, nb As Long, reste As Long, k As Long, titi As String
  lgb = 30000 ' ----->> taille de bloc à traiter (à à mettre à la valeur de votre choix ...)
  fics = Array("d:\fic1.txt", "d:\fic2.txt", "d:\fic3.txt")
  desti = "d:\desti.txt"
  If Dir(desti, vbHidden Or vbNormal) <> "" Then Kill desti
  Open desti For Append As #2
   For n = 0 To UBound(fics)
     Open fics(n) For Input As #1
       lgt = LOF(1): nb = lgt \ lgb: reste = lgt Mod lgb
       For k = 1 To nb
         titi = Input(lgb, #1): Print #2, titi;
       Next
       titi = Input(reste, #1)
       If Right(titi, 2) = vbCrLf Then titi = Left(titi, Len(titi) - 2)
       Print #2, titi
   Close #1
   DoEvents
  Next
 Close #2

on fusionne ainsi tous les fichiers de l'array Fics
J'ai ici utilisé par fainéantise #1 et #2. Je vous laisse les modifier par des Freefile, hein ...

Supprimer une ligne blanche lors de la fusion de fichiers .txt (VBA) [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager