Discussion :

[breizhgen]

Bonjour,

je souhaiterais copier l'ensemble des lignes se situant dans un endroit précis du fichier externe, les couper et les recoller dans un nouveau fichier .txt

Ensuite les deux fichiers seront sauvegardés.

Exemple mon fichier texte comprends 200 lignes, à la ligne 125 il est inscrit COUPER ICI.

Je voudrais que le script VBA trouve ce texte "COUPER ICI." et sélectionne l'ensemble des lignes se trouvant avant celle-ci, les coupent et les recollent dans le nouveau fichier.

Il y aura donc 2 nouveau fichiers l'un reprenant les lignes 1 à 124, l'autre les lignes 125 à 200

Je ne sais pas si je suis très clair...

Merci de votre aide

David

[breizhgen]

Re bonjour,

en fait pour mieux m'expliquer, il s'agirait de scinder le fichier .txt en 2 nouveaux fichiers .txt avec pour repère de scindement la ligne comportant "0 @F1@ FAM" qui est totalement unique dans le fichier source.

Merci

[Invité]

Bonjour,

A tester :

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
 
Option Explicit
 
Sub TestScinderEnDeuxFichiersTxt()
 
Dim RepertoireSauvegarde As String
 
    RepertoireSauvegarde = ActiveWorkbook.Path
    ScinderEnDeuxFichiersTxt RepertoireSauvegarde, "Fichier source.txt", "Cible1.txt", "Cible2.txt", "0 @F1@ FAM"
 
 End Sub
 
 
Sub ScinderEnDeuxFichiersTxt(RepertoireFichier As String, NomFichier As String, Fichier1 As String, Fichier2 As String, ChaineATrouver As String)
 
Dim InputData As String, FichierEnCours As String
Dim fs, f1, f2
 
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f1 = fs.CreateTextFile(RepertoireFichier & "\" & Fichier1, True)
    Set f2 = fs.CreateTextFile(RepertoireFichier & "\" & Fichier2, True)
 
 
    Open RepertoireFichier & "\" & NomFichier For Input As #1
    FichierEnCours = "1"
 
    Do While Not EOF(1)
 
       Line Input #1, InputData
       If InStr(1, InputData, ChaineATrouver, vbTextCompare) > 0 Then
          FichierEnCours = "2"
          Line Input #1, InputData
       End If
 
       If FichierEnCours = "1" Then
          f1.Write InputData & vbNewLine
       Else
          f2.Write InputData & vbNewLine
       End If
 
    Loop
 
     Close #1
     f1.Close
     f2.Close
 
     Set f1 = Nothing: Set f2 = Nothing
     Set fs = Nothing
 
 
End Sub

[breizhgen]

Bonjour Eric,

merci, cela fonctionne parfaitement mais la ligne comportant "0 @F1@ FAM" ne dois pas être supprimée mais elle dois devenir la 1ere ligne du second fichier.

En te remerciant

David

[Invité]

Il faut supprimer la ligne 33 dans le précédent code :

Code :

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

1
2
3
4
 
  If InStr(1, InputData, ChaineATrouver, vbTextCompare) > 0 Then
          FichierEnCours = "2"
       End If

[breizhgen]

Merci beaucoup !!

[Pierre Fauconnier]

Salut.

Pour le fun

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
Sub Test()
  Dim Cha1 As Long, Cha2 As Long, Cha3 As Long
  Dim r As String
  Dim Flag As Boolean
 
  Cha1 = FreeFile
  Open "c:\data\temp\couper.txt" For Input As Cha1
  Cha2 = FreeFile
  Open "c:\data\temp\premier.txt" For Output As Cha2
  Cha3 = FreeFile
  Open "c:\data\temp\deuxième.txt" For Output As Cha3
 
  Do While Not EOF(Cha1)
    Line Input #Cha1, r
    If Not Flag Then
      If r <> "COUPER ICI" Then
        Print #Cha2, r
      Else
        Flag = True
      End If
    Else
      Print #Cha3, r
    End If
  Loop
  Close #1
  Close #2
  Close #3
End Sub