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

**paqmarc** · 13/03/2018, 20h24

Bonjour,
Ce code fonctionne parfaitement lorsque je fusionne 3 fichiers .txt. Par contre, je ne sais pas comment m'y prendre pour supprimer les possibles les lignes blanche que pourrait contenir chacun des fichiers à la source?
J'ai essayé de mettre une variable temp2 et faire un trim dessus sans succès. Alors comment puis-je le faire directement sur l'instruction Temp = Input(LOF(X), #X)

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
Option Private Module
Sub Fusion_Send_File_Txt(ByRef NameJourCour As String)
  Dim fichier_final As String, Temp As String, Chemin As String, Fichier As String
 
  Dim X As Long, x2 As Long
  Dim i As Integer
 
  Chemin = RepRptEnv 'Endroit où sont regroupés les fichiers texte à modifier
  fichier_final = RepEnv & NameJourCour 'Le nom du fichier où doit être compiler toutes les données
 
   Fichier = Dir(Chemin & "\*.txt")
 
   i = 0
  Do
     X = FreeFile
     Open Chemin & Fichier For Input As #X
     Temp = Input(LOF(X), #X)
     Close #X
     x2 = FreeFile
     Open fichier_final For Append As #x2
     'If Not Left(Temp, 1) = "" Then
       Print #X, Temp ' & vbCrLf ' si vous; voulez; pas une ligne vide entre chaque fichier; supprimer le  "& vbcrlf"
     'End If
     Close #X
     i = i + 1
     Fichier = Dir()
   Loop Until Fichier = ""
   x2 = FreeFile
End Sub

Voici le résultat de mon programme si je fusionne les 3 fichiers .txt:

RV0509
VB0032
VB0041
VB0357
VB0525
VB0612
MQ0203
<-------- lignes blanche à supprimer ?
MQ0211
VQ0026
VQ0205
VQ0636
VQ0706
VQ0862
VQ0928
VQ1456
VQ1718
<-------- lignes blanche à supprimer ?
VQ2123
VQ2361
VQ2362
VQ2363
VQ2364
VQ2372
VQ2373
VQ2374
VQ2375
VQ4444
<-------- lignes blanche à supprimer ?

Merci de votre aide !

**patricktoulon** · 13/03/2018, 21h37

bonsoir
essaie tout simplement

Code :

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

Temp = replace(Input(LOF(X), #X),vbcrlf & vbcrlf,vbcrlf)

edit:

il y a peu etre méprise de ma part en fait cette ligne vide est peutre la derniere ligne de chaque fichier
il faudra alors supprimer le dernier saut de ligne de chaque fichier il faudra alors boucler sur un split vbcrlf et récrire temp dans temp2 de la ligne 0 a ubound(split,vbcrlf)-1
et dans le print mettre temp2
dis moi d'abords si le replace est bon

**paqmarc** · 13/03/2018, 22h02

Bonjour,

Merci pour votre réponse mais cela donne toujours le même résultat lors de la génération du fichier .txt
Les lignes blanche sont toujours là !

**paqmarc** · 13/03/2018, 22h08

Bonjour,
Je viens de voir ta modification mais je ne suis pas certain ce que tu veux dire...
Dans cet exemple, on suppose que je n'ai pas le contrôle de la génération des fichiers. Donc s'il y a une ligne blanche(vide) dans l'un de mes fichiers, faut que mon programme
le détecte et supprime cette ligne.

Merci encore

edit:

il y a peu etre méprise de ma part en fait cette ligne vide est peutre la derniere ligne de chaque fichier
il faudra alors supprimer le dernier saut de ligne de chaque fichier il faudra alors boucler sur un split vbcrlf et récrire temp dans temp2 de la ligne 0 a ubound(split,vbcrlf)-1
et dans le print mettre temp2
dis moi d'abords si le replace est bon[/QUOTE]

**unparia** · 14/03/2018, 01h18

Bonjour
as-tu essayé de mettre un un retour charriot et un point-virgule après le print à ce niveau :

Code :

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

1
2
3
4
5
Open fichier_final For Append As #x2
     'If Not Left(Temp, 1) = "" Then
       Print #X, Temp  & vbCrLf; ' si vous; voulez; pas une ligne vide entre chaque fichier; supprimer le  "& vbcrlf"
     'End If
     Close #X

ceci étant dit, il se peut que les fichiers texte aient eux-mêmes été mal écrits et se terminent déjà par un vbcrlf.
Dans ce cas : ajouter le point-virgule, mais pas le vbcrlf, ainsi :

Code :

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

Print #X, Temp;

**patricktoulon** · 14/03/2018, 08h03

re oui comme je l'ai dis il est fort probable que les .txt se termine par un saut de ligne je viens de faire un test (sauver quelque lignes en csv et en effet il y a bien un saut de ligne a la fin

le ";" virgule ne regle pas le soucis il faut absolument supprimer ce saut de ligne pas le choix ( boucle sur ligne ) a moins que right( texte,2) fonctionne j'ai pas testé
en reflechissant un peu une astuce a la patricktoulon
faire un replace provisoire sur vbcrlf par "|" et prendre le rigth(texte,2) puis replacer les "|" par vbcrlf on fait sauter ainsi le dernier vbcrlf

ainsi (les etoiles represente un saut de ligne)

toto*
titi*
riri*
fifi*
*

se transformerait en

toto|titi|riri|fifi|

avec le rigth(texte,2) il se transformerait en ceci

toto|titi|riri|fifi

et enfin avec le replace "|" par vbcrlf

toto
titi
riri
fifi

je sais c'est un peu tomutch mais si ca evite de spliter boucler et réécrire dans una variable temp(2) etc.....

APRES TOUT CA
il y a une solution peu etre plus propre
en effet tu utilise le "readall" avec eof(x) mais tu pourrais utiliser le read ligne par ligne ,si la ligne contient quelque chose tu la met dans ton fichier final avec append sinon tu continue jusqu' a la fin de chaque fichier
et la on est sur de faire sauter les lignes vides
attention quand meme il est possible que des lignes vides soit en plein milieu du texte (ses lignes la doivent elles etres gardées ou pas)
bref solution il y a

edit:
pour la solution du replace essaie ceci en changeant le nom du fichier et regarde les msgbox

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub lecture3()    ' recupe le texte complet avec input simple
    Dim x As Integer: x = FreeFile
    Dim lines As String, i As Long
    fichier = "C:\Users\polux\Desktop\Classeur1.csv"
    Open fichier For Input As #x
    lines = Replace(Input$(LOF(x), #x), vbCrLf, "|")
    MsgBox "la fin du texte est : " & Right(lines, 1)
    lines = Replace(Mid(lines, 1, Len(lines) - 1), "|", vbCrLf)
    Close #x
    MsgBox "Maintenant la fin du texte est : " & Right(lines, 1)
End Sub

tu aura soit la derniere lettre du dermier mot soit un";" si il y a un";" a la fin de chaque ligne

**patricktoulon** · 14/03/2018, 09h15

Mauvaise nouvelle je viens de faire le test integral je replace bien les dernier sait de ligne mais il est recréé dans le append du fichier final

seule solution réouvrir le fichier final a la fin et supprimer les lignes vides pas d'autre choix
je me suis fait avoir moi aussi

solution categorique

pour le test j'ai bouclé 5 fois

on créé un fichier final vide ET !!! on le ferme
on boucle sur les fichier puis ouverture avec open for input
on recupere le texte du fichier ouvert
on le ferme
DANS LA BOUCLE!!!! on réouvre cette fois ci le fichier final mais en append
on y ajoute le texte puis on ferme le fichier final
fin de boucle sur fichier
on reouvre le fichier final en input pour lire le contenu puis fermeture du fichier final
on suprime les doubles "vbcrlf & vbcrlf" tout simplement dans "lines" qui est la variable qui contient le texte du LOF(X)(readall)
on réouvre mais cette fois ci en mode "output"( ecrasement du contenu existant) pour ecrire le texte replacé
fermeture tu fichier final

voila c'est fini il n'y a plaus de saut de ligne entre chaque texte de fichier dans le fichier final
pour l'exemple j'ai utiliser le meme fichier a chaque fois
a toi de determiner le nom dans la boucle

voila j'ai largement commenté le code qui est relativement simple

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
Sub lecture3()    ' recupe le texte complet avec input simple
    Dim x As Integer, x2 As Integer: x = FreeFile: x2 = FreeFile
    Dim lines As String, i As Long
    ''fichier = "C:\Users\polux\Desktop\Classeur1.csv"
    fichierfinal = "C:\Users\polux\Desktop\Classeurfinal.csv"
    Open fichierfinal For Output As #x2: Close #x2    ' on créé le csv final(VIDE!!!)
    ' pour l'exemple je vais ouvrir le fichier 5 fois , le lire et ecrire le reste dans le fichier final
    For i = 1 To 5
        fichier = "C:\Users\polux\Desktop\Classeur1.csv" 'le nom des fichiers successif a determiner ici
        Open fichier For Input As #x    'ouverture du fichier a copier
        lines = Input$(LOF(x), #x)    ' récupération du texte du fichier a copier dans la variable lines
        Close #x    ' fermeture du fichier
        Open fichierfinal For Append As #x2:    ' on réouvre le """fichier final""" en mode append(mise ajour)
        Print #x2, lines    ' on y ecrit(ajoute) le contenu de lines
        Close #x2    'on ferme le fichier final
    Next
    'a partir de maintenant on a tout les fichier dans le fichier final
    'mais il va falloir le netoyer de ces lignes vides
    Open fichierfinal For Input As #x    ' on réouvre donc le fichier final EN LECTURE !!!!!!
    lines = Replace(Input$(LOF(x), #x), vbCrLf & vbCrLf, "")    ' on recupere le contenu dans la variable lines en replacant les double saut de ligne par RIEN!!!!
    Close #x    'on le referme
    ' nous allons maintenant réouvrir le fichier final mais cette fois ci en mode output!!!!!( creation)
    'ce qui va avoir pour effet d'ecraser l'existant
    ' on créé le csv final(VIDE!!!)comme la premiere fois puis on y met le contenu de la variable lines qui n'a plus de saut de lignes vides
    Open fichierfinal For Output As #x2: Print #x2, lines: Close #x2    ' on le referme a la fin
End Sub

*****voir avec adobstrean on peut pas faire plus simple

**paqmarc** · 28/03/2018, 18h12

Bonjour.. finalement j'ai trouvé dans un autre groupe.. j'ai ajouté des commentaires sur les instructions selon ma compréhension, merci de m'informer si correction à faire.

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
Do While Fichier <> ""
    If Fichier <> FichierCompilation Then
      Open Chemin & Fichier For Binary Access Read As #X
      Temp = String(LOF(X), Chr(0)) 'Obtient la longueur du fichier en enlevant le caractère ayant la valeur 0.
      Get #X, , Temp    'Obtient le nouveau fichier sans le caractère ayant la valeur 0 (Null)
      t = t & Temp  ' Cumul chacun des fichiers dans t
      Close #X
    End If
   Fichier = Dir()  'Passe au prochain fichier
   Loop
   Lignes = Len(t) - _
   Len(Application.WorksheetFunction.Substitute(t, Chr(10), ""))    'Compteur total du nombre de lignes sans le caractère de retour de charriot
   Lignes = Lignes + 1 'Ajoute au compteur l'enveloppe des rapports SGA
   t = Left(t, Len(t) - 1)
   Open FichierCompilation For Output As #X
   Print #X, t
   Close #X
   MsgBox "Le fichier " & NameJourCour & " est maintenant disponible sous le répertoire:" & vbCrLf & "" & vbCrLf & RepRet & vbCrLf & "" & vbCrLf & " Il contient provisoirement " & Lignes & " médias à faire revenir de la voûte !" & vbCrLf & "" & vbCrLf & "Veuillez faire vos ajouts manuels dans ce fichier !", vbInformation, "Message d'information"
End Sub

**patricktoulon** · 28/03/2018, 20h16

re
ben oui une erreur d'appreciation serait celle ci

Code :

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

1
2
Get #X, , Temp    'Obtient le nouveau fichier sans le caractère ayant la valeur 0 (Null)
      t = t & Temp  ' Cumul chacun des fichiers dans t

tu cumule tout les textes des fichier dans la variable "T"
sauf que si tu depasse la limite possible de T ca va planter et y aura rien a faire
tandis que l'exemple que je t'ai donné ajoute au fur et a mesure dans un fichier final
la memoire est moins surchargé

**paqmarc** · 29/03/2018, 18h08

Bonjour Patrick,
Merci pour ton suivi. Tu as probablement raison sur le fait que de cumuler tout dans T risque de faire planter le tout si je dépasse la capacité.
Sais-tu comment déterminer la capacité d'une variable ?

J'ai adapté ton code à mon programme et il marche "presque" très bien. Par contre, j'ai ce résultat avec ta ligne de commande:

Code :

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

lines = Replace(Input$(LOF(x), #x), vbCrLf & vbCrLf, "")   ' on recupere le contenu dans la variable lines en replacant les double saut de ligne par RIEN!!!!

Il donne ceci comme résultat:
VQ1751
VQ1931RV0021
RV0181
RV0607
RV0798TQ0001
TQ0030
TQ0072

Pour contourner le problème, j'ai fais ceci:

Code :

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

lines = Replace(Input$(LOF(x), #x), vbCrLf & vbCrLf, vbCrLf & "")   ' on recupere le contenu dans la variable lines en replacant les double saut de ligne par RIEN!!!!

J'ai aussi ajouté un compteur de lignes pour mes besoins et cela fonctionne très bien . Il est important pour moi de ne pas avoir de retour de charriot à la fin du dernier fichier.
J'ai aussi enlevé l'instruction If Fichier <> fichierfinal dans ma boucle. Inutile selon moi
J'ai ajouté l'instruction lines = Left(lines, Len(lines) - 1) pour enlever le dernier retour de charriot (vbCrLf)

Voici mon code qui fonctionne très bien maintenant à partir de ta méthode, qu'en penses-tu ?

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
Sub Fusion_Send_File_Txt(ByRef NameJourCour As String)
Dim x As Integer, x2 As Integer: x = FreeFile: x2 = FreeFile
Dim lines As String
Dim Chemin As String
Dim Lignes As Long
 
Chemin = RepRptEnv 'Endroit où sont regroupés les fichiers texte à modifier
fichierfinal = RepEnv & NameJourCour 'Le nom du fichier où doit être compiler toutes les données
 
Open fichierfinal For Output As #x2: Close #x2    ' on créé le csv final(VIDE!!!)
 
Fichier = Dir(Chemin & "*.txt")
 
Do While Fichier <> ""
    Fichier = RepRptEnv & Fichier 'le nom des fichiers successif a determiner ici
    Open Fichier For Input As #x    'ouverture du fichier a copier
    lines = Input$(LOF(x), #x)    ' récupération du texte du fichier a copier dans la variable lines
    Close #x    ' fermeture du fichier
    Open fichierfinal For Append As #x2:    ' on réouvre le """fichier final""" en mode append(mise ajour)
    Print #x2, lines    ' on y ecrit(ajoute) le contenu de lines
    Close #x2    'on ferme le fichier final
Fichier = Dir() 'Passe au prochain fichier
Loop
Open fichierfinal For Input As #x    ' on réouvre donc le fichier final EN LECTURE !!!!!!
lines = Replace(Input$(LOF(x), #x), vbCrLf & vbCrLf, vbCrLf & "")   ' on recupere le contenu dans la variable lines en replacant les double saut de ligne par un saut de ligne et blanc ""
Lignes = Len(lines) - _
Len(Application.WorksheetFunction.Substitute(lines, Chr(10), ""))    'Compteur total du nombre de lignes sans le caractère de retour de charriot
lines = Left(lines, Len(lines) - 1) 'Enlève le dernier retour de charriot sur le dernier fichier à la toute fin
Close #x    'on le referme
 
  ' nous allons maintenant réouvrir le fichier final mais cette fois ci en mode output!!!!!( creation)
  'ce qui va avoir pour effet d'ecraser l'existant
  ' on créé le csv final(VIDE!!!)comme la premiere fois puis on y met le contenu de la variable lines qui n'a plus de saut de lignes vides   Open fichierfinal For Output As #x2: Print #x2, lines: Close #x2    ' on le referme a la fin
Open fichierfinal For Output As #x2: Print #x2, lines: Close #x2    ' on le referme a la fin
MsgBox "Le fichier " & NameJourCour & " est maintenant disponible sous le répertoire:" & vbCrLf & "" & vbCrLf & RepEnv & vbCrLf & "" & vbCrLf & " Il contient provisoirement " & Lignes & " médias à envoyer à la voûte !" & vbCrLf & "" & vbCrLf & "Veuillez faire vos ajouts manuels dans ce fichier !", vbInformation, "Message d'information"
End Sub

**Marc-L** · 29/03/2018, 23h54

Salut !

Patrick, tu ne te rappelles pas ce que je t'avais montré via Split & UBound ?
Donc sans Replace, juste en testant la dernière ligne …

Autre voie simple : lire les lignes une à une et les écrire uniquement si elles ne sont pas vides !

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**patricktoulon** · 30/03/2018, 08h33

bonjour Marc
oui mais le dernier saut de ligne se créer lors du print #x j'ai testé
lire ligne par ligne il me semble l'avoir évoqué aussi
il y a la methode open sur excel aussi > supression des ligne vide >enregistrement en csv ou text
bref solution il y a

et j'ai fait un test interessant
une variable string ayant une limite j'ai procedé autrement
encore une fois le htmlfile
on peut mettre plus de texte a l'interieur qu'une variable string
je vous laisse deviner la suite

**Marc-L** · 30/03/2018, 10h01

D'abord la simple lecture ligne à ligne Line Input # + contrôle + Print # ne pose aucun problème …
Et c'est aussi rapide voir plus que le code du post #10 vu la fermeture inutile du fichier final entre chaque fichier source !

Ensuite dans le cas d'une lecture globale via une variable tableau si elle est amputée de son dernier élément vide
via un simple ReDim alors son écriture globable via Join + Print # ne pose pas de problème non plus !
Sinon sans Redim juste via une simple boucle ce sera peut-être même plus rapide en cas de gros fichier …

**patricktoulon** · 30/03/2018, 10h21

re

Et c'est aussi rapide voir plus que le code du post #10 vu la fermeture inutile du fichier final entre chaque fichier source !

désolé marc

mais si x1 n'est pas fermé x2 me declenche l'erreur (fichier deja ouvert) alors que se sont deux fichiers differents et deux variables X differentes

**Marc-L** · 30/03/2018, 10h26

Rappel de la logique la plus élémentaire :

créer le fichier final en écriture en début de procédure avant la boucle sur Dir et ne le fermer qu'après la boucle ‼
Donc Append inutile, comme déjà publié plusieurs fois dans ce forum …

**patricktoulon** · 30/03/2018, 10h35

Envoyé par Marc-L

Rappel de la logique la plus élémentaire :

créer le fichier final en écriture en début de procédure avant la boucle sur Dir et ne le fermer qu'après la boucle ‼
Donc Append inutile, comme déjà publié plusieurs fois dans ce forum …

????????????????????????

"Donc Append inutile" donc tu stoke le texte alors que c'est le sujet de la contreverse

créer le fichier final en écriture en début de procédure avant la boucle sur Dir et ne le fermer qu'après la boucle ‼

je le redis chez moi pas possible j'ai l'erreur"fichier deja ouvert" si j'essaie d'ouvrir deux fichiers (#x1,#x2) que se soit ouput,input,append

**Marc-L** · 30/03/2018, 10h46

Purée non pas de stockage de texte au sein de la boucle ‼

• Ouverture en écriture du fichier final canal #1

• Début de boucle Dir

• Ouverture et lecture d'un fichier source canal #2, écriture des lignes non vides dans le fichier final, fermeture du fichier source
(quelle que soit la méthode, ligne à ligne ou globale …)

• Fin de boucle

• Fermeture du fichier final

Niveau de difficulté : grand débutant ! … Consulter l'aide VBA de Line Input # …

**patricktoulon** · 30/03/2018, 11h15

re puré
si je te dis que

Code :

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

1
2
3
4
5
open fichierfinal for output #x2'ouverture en ecriture simple 
'blablabla
for i= ........'boucle fichier
fichier=c:\................
open fichier for input #x1

'beep beep erreur!!!!!!!!!!!!!!!!!!!!!!!!!'fichier deja ouvert" des le premier fichier alors que seul le fichierfinal est ouvert
'blabla lecture

me declenche l'erreur'fichier deja ouvert"c'est que c'est le cas !

je peux pas etre plus clair

demonstration simple qui prouve bien que je ne peux pas ouvrir 2 fichier qu'importe le mode en meme temps sans fermer le precedent
Nom : Capture.JPG
Affichages : 701
Taille : 114,6 Ko

Nom : Capture.JPG
Affichages : 701
Taille : 114,6 Ko

**pijaku** · 30/03/2018, 11h23

Bonjour,

Hum, hum, Patrick.....

Code :

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

1
2
3
4
5
6
7
Sub Demo()
Dim x1 As Integer, x2 As Integer
   x1 = FreeFile
'il faut ouvrir ton premier fichier ici pour que x1 ne soit plus un numéro libre!
   x2 = FreeFile
   Debug.Print x1 = x2
End Sub

EDIT : démo plus complète :

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Demo()
Dim x1 As Integer, x2 As Integer
   x1 = FreeFile
   x2 = FreeFile
   Debug.Print x1 = x2
   Open "C:\Users\" & Environ("username") & "\Desktop\output.txt" For Output As #x1
      x2 = FreeFile
   Debug.Print x1 = x2
   Close #x1
End Sub

**patricktoulon** · 30/03/2018, 11h47

re
bonjour franck
autant pour moi je le reconnais je faisait une erreur sur l'item X les deux ne peuvent pas etre freefile entre temps je m'en etais rendu compte

donc pour le demandeur en reprenant son code modifié comme suit

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
Sub Fusion_Send_File_Txt(ByRef NameJourCour As String)
    Dim fichier_final As String, Temp As String, Chemin As String, Fichier As String
    Dim X As Long, x2 As Long
    Dim i As Integer
    x2 = 2
    x1 = 1
    Chemin = RepRptEnv    'Endroit où sont regroupés les fichiers texte à merger
    fichier_final = RepEnv & NameJourCour    'Le nom du fichier où doit être compiler toutes les données
    Open fichier_final For Append As #x2
    Fichier = Dir(Chemin & "\*.txt")
    Do
        Open Chemin & Fichier For Input As #x1
        While Not EOF(x1)    'lecture ligne par ligne dans une boucle while/wend
            Line Input #x1, DataLine    'on est tranquille on a pas a se soucier de la taille du  fichier il est lu ligne par ligne
            If Len(DataLine) > 0 Then Print #x2, DataLine    'on inscrit la ligne dans le fichierfinal si elle contient quelque chose
        Wend
        Close #x1
        Fichier = Dir()
    Loop Until Fichier = ""
    Close #x2
End Sub