Ajouter une insertion de colonne dans macro

Bonjour,

On m'avait fournie une petite macro pour ajouter ou supprimer la première ligne de mes fichiers txt qui fonctionne très bien mais j'aimerais y ajouter une option.

J'aimerais ajouter une colonne en troisième position avec comme entête Temps et inscrire 00:00:01 sur toutes les lignes de cette colonne et quel ait la même longueur que les autres

Pouvez-vous aider la quiche VBA que je suis pour intégrer cette fonction ?

PS : Je peux faire cette ajout en 2 fois si cela est plus facile en supprimant la première ligne puis intégrant la colonne

Merci d'avance

Je joint 2 fichiers de données et mon fichier comportant la macro

Slt Auverland,

qui a inseré les colonnes déjà existantes?

Bonjour,

Mes fichiers TXT sont générés par un enregistreur qui ne sais pas insérer cette colonne Temps.

J'ai 2000 fichiers d’acquisition que j'aimerais traiter mais mon outil qui est verrouiller et non évolutif il as besoin de cette colonne pour fonctionner.

La colonne Temps peux rester à zéro tout du long il faut juste qu'elle est la même longueur que les autres colones

Pour fonctionner il veux les fichier sous ce format :

Premiere ligne : un texte

Deuxieme ligne : Date Heure Temps et apres mes voies de mesures

Troisieme ligne : 08/02/2019 15:53:40 00:00:00 et apres mes données mesuré Ect...

Merci d'avance

Bonjour,

j'ai essayé de lire ton fichier avec le séparateur Chr(32)

 s = Split(oTxt.ReadLine, Chr(32))

et aussi

s = Split(oTxt.ReadLine, Chr(13) & Chr(10))

mais rien ne split ?

re,

c'est bon j'ai trouvé --> Chr(9)

à tester,

Option Explicit

Sub test()
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Dim i As Long, rw As Long, n As Integer, s, t As String, fileName As String, Var As String

fileName = "C:\Users\isabelle\Documents\Test10\##_du_081118_à_1500223.txt"  '<--à adapter
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(fileName)
Set oTxt = oFl.OpenAsTextStream(ForReading)

Sheets.Add After:=Sheets(Sheets.Count)

While Not oTxt.AtEndOfStream
  rw = rw + 1
  Range("A" & rw) = oTxt.ReadLine
Wend

Set oTxt = oFSO.CreateTextFile("C:\Users\isabelle\Documents\Test10\##_du_081118_à_1500223(corr).txt")   '<--à adapter

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If i = 1 Then Var = "Temps" Else Var = "00:00:01"
    s = Split(Range("A" & i), Chr(9))
        For n = LBound(s) To UBound(s)
          Select Case n
            Case 1: t = t & s(n) & Chr(9) & Var & Chr(9)
            Case Else: t = t & s(n) & Chr(9)
          End Select
        Next n
    oTxt.WriteLine t
    t = ""
Next i

Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub

slt Auverland,

@i20100: magnifique!

re,

Merci m3ellem1,

voici une nouvelle version pour modifier tous les fichier.txt d'un répertoire,

ps / sans l'utilisation d'une feuille

Option Explicit
'ajouter la référence Microsoft Scripting Runtime
Sub test3()
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Dim oFile, sfoFolder
Dim s, i As Long, rw As Long, n As Integer, t As String, Var As String, Nouveufichier As String
Dim tbl()

Set oFSO = New Scripting.FileSystemObject
Set sfoFolder = oFSO.GetFolder("C:\Users\isabelle\Documents\Test11")  '<--répertoire à adapter

For Each oFile In sfoFolder.Files
  If LCase(Right(oFile, 4)) = ".txt" Then
    Set oFl = oFSO.GetFile(oFile)
    Set oTxt = oFl.OpenAsTextStream(ForReading)

    s = Split(oFile, ".")
    Nouveufichier = s(0) & "(corr).txt"

    rw = 0
    While Not oTxt.AtEndOfStream
      rw = rw + 1
      ReDim Preserve tbl(rw)
      tbl(rw) = oTxt.ReadLine
    Wend

    Set oTxt = oFSO.CreateTextFile(Nouveufichier)

    For i = LBound(tbl) To UBound(tbl)
        If i = 1 Then Var = "Temps" Else Var = "00:00:01"
        s = Split(tbl(i), Chr(9))
            For n = LBound(s) To UBound(s)
              Select Case n
                Case 1: t = t & s(n) & Chr(9) & Var & Chr(9)
                Case Else: t = t & s(n) & Chr(9)
              End Select
            Next n
        oTxt.WriteLine t
        t = ""
    Next i
  End If
Next oFile
End Sub

Bonjour,

Merci pour votre aide sur mon sujet

vous êtes au top

Je vais juste faire une tite précision pour ceux qui souhaiteraient utilisé cette macro, il faut dans VBA "outils" / Référence... activé l'option Microsoft Scripting Runtime’ .

Je l'avais pas d'origine du coup j'avais le message d'ereur ==>

Erreur de compilation Type non défini par l'utilisateur non défini

et bloque sur :

Dim oFSO As Scripting.FileSystemObject

Et j'ai due suprimer ActiveSheet.Delete a la fin

Bon dimanche

re,

désoler pour les p'tit ennuis, c'est corriger,

a part ça, est ce que ça fait le boulot tel que désiré ?

Super vraiment satisfaite du résultat

en plus cela mange si on peu dire mes gros fichiers..

Merci pour ce retour, au plaisir!