Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Macro - Combiner fichiers Bloc-Note

Bastien43

XLDnaute Occasionnel
Bonjour,

Je cherche à combiner en créant une macro (bouton) des fichiers texte bloc-note. 3 fichiers bloc-note dans 3 dossiers différents, en gardant juste cette en-tête et en supprimant les autres en-tête :

;Calage en Pression
;Localisation Heure Valeur
;--------------------------

Quelqu'un a -t-il une solution svp ?

Je vous remercie
Cordialement
Bastien
 

Pièces jointes

  • Calage_pression_Fluks.txt
    2.3 KB · Affichages: 17
  • Calage_pression_hauteur_niveau_reservoirs.txt
    445 bytes · Affichages: 9
  • Calage_pression_Terrain.txt
    1.4 KB · Affichages: 7
Solution
Bonjour Bastien43, le forum,

Si l'on ne veut pas copier à chaque fois les 3 lignes de titres utiliser :
VB:
Sub Regrouper_TXT()
Dim chemin$, i&, a$(), n As Byte, fichier$, nn&, x%, texte$
chemin = ThisWorkbook.Path & "\"
i = 3
ReDim a(i) 'tableau VBA, base 0
a(0) = ";Calage en Pression"
a(1) = ";Localisation Heure Valeur"
a(2) = ";--------------------------"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        Line Input #x, texte: Line Input #x, texte: Line Input #x, texte 'saute 3 lignes
        While Not...

job75

XLDnaute Barbatruc
Bonjour à tous,

Téléchargez le fichier .xlsm et les 3 dossiers zippés dans le même répertoire (le bureau).

La macro affectée au bouton :
VB:
Sub Regrouper_TXT()
Dim chemin$, n As Byte, fichier$, nn&, x%, texte$, a$(), i&
chemin = ThisWorkbook.Path & "\"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        While Not EOF(1) 'EndOfFile : fin du fichier
            Line Input #x, texte 'récupère la ligne
            ReDim Preserve a(i) 'tableau VBA, base 0
            a(i) = texte
            i = i + 1
        Wend
        Close #x
        fichier = Dir 'fichier suivant
    Wend
Next
'---restitution---
x = FreeFile
Open chemin & "Fichier_Pression_Final.txt" For Output As #x 'accès en écriture
Print #x, Join(a, vbLf)
Close #x
MsgBox nn & " fichiers textes ont été regroupés dans 'Fichier_Pression_Final.txt'..."
End Sub
A+
 

Pièces jointes

  • Données.zip
    16.4 KB · Affichages: 1

Bastien43

XLDnaute Occasionnel
Bonsoir @job75 ,

Encore merci pour la macro et pour votre aide. Vous m'avez permis d'avancer et de gagner énormément de temps.

Bonne soirée
Bastien
 

job75

XLDnaute Barbatruc
Bonjour Bastien43, le forum,

Si l'on ne veut pas copier à chaque fois les 3 lignes de titres utiliser :
VB:
Sub Regrouper_TXT()
Dim chemin$, i&, a$(), n As Byte, fichier$, nn&, x%, texte$
chemin = ThisWorkbook.Path & "\"
i = 3
ReDim a(i) 'tableau VBA, base 0
a(0) = ";Calage en Pression"
a(1) = ";Localisation Heure Valeur"
a(2) = ";--------------------------"
For n = 1 To 3 'pour 3 dossiers, à adapter
    fichier = Dir(chemin & "Dossier" & n & "\") '1er fichier du dossier
    While fichier <> ""
        nn = nn + 1
        x = FreeFile
        Open chemin & "Dossier" & n & "\" & fichier For Input As #x 'accès en lecture séquentielle
        Line Input #x, texte: Line Input #x, texte: Line Input #x, texte 'saute 3 lignes
        While Not EOF(1) 'EndOfFile : fin du fichier
            Line Input #x, texte 'récupère la ligne
            ReDim Preserve a(i)
            a(i) = texte
            i = i + 1
        Wend
        Close #x
        fichier = Dir 'fichier suivant
    Wend
Next
'---restitution---
x = FreeFile
Open chemin & "Fichier_Pression_Final.txt" For Output As #x 'accès en écriture
Print #x, Join(a, vbLf)
Close #x
MsgBox nn & " fichiers textes ont été regroupés dans 'Fichier_Pression_Final.txt'..."
End Sub
Voyez le fichier (2) zippé joint.

A+
 

Pièces jointes

  • Données.zip
    16.8 KB · Affichages: 2

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…