Extraire certaines données EXCEL vers Fichiers TXT

benny47

XLDnaute Junior
Bonjour,

J'utilise actuellement un fichier excel déja "VBA lisé"...
Voilà, j'aimerais extraire certaines données de ce tableau et les envoyer dans un fichier TXT ( en le créant au passage grace à un petit bouton ).

Il faudrait simplement que les données qui sont à la suite sur la ligne 1 et celle qui sont également à la suite sur la ligne 2 etc etc ... se mettent l'une en dessous de l'autre dans le fichier TXT ( tout simplement ... ! )

Mais apparemment trop compliqué pour moi ...

Merci !
 

job75

XLDnaute Barbatruc
Re : Extraire certaines données EXCEL vers Fichiers TXT

Bonjour benny47,

A priori il faut recréer à chaque fois le fichier txt, après avoir créé de nouvelles lignes dans le fichier Excel.

Sans fichier joint et des exemples concrets difficile d'en dire beaucoup plus.

A+
 

benny47

XLDnaute Junior
Re : Extraire certaines données EXCEL vers Fichiers TXT

salut job75...

non. 1 seul fichier txt .

Mais avec toutes mes données extraient d'excel l'une en dessous de l'autre ...

voici un lien du fichier txt que je voudrais au final .. avec des débuts de ligne qui reste ( en fait tout le texte avec le = )

http://cjoint.com/?BGmkACeEivy

il faudrait qu'il y ai toujours les débuts de ligne comme ( DATE= ; FINI = ; etc ... )et que aprés le = ,ma donnée extraite d'excel vienne se mettre.

compliqué ? non ?
 

benny47

XLDnaute Junior
Re : Extraire certaines données EXCEL vers Fichiers TXT

re hello
J'ai réussi a créer un fichier txt depuis un " commandbutton"
Il me créé bien le fichier .txt ..
mais je n'arrive pas à aller lui faire chercher des valeurs dans mon tableau Excel !!
en les mettant l'un en dessous de l'autre. ( à la ligne , quoi )
voici mon code ..

Set FSys = CreateObject("Scripting.FileSystemObject")
Set MonFic = FSys.CreateTextFile("\\lxes03-003fs\home$\leratb\MTG_essai.txt")
With MonFic 'Pour écrire dans le fichier texte
.writeLine "Message à ecrire" 'Mettre write pour ne pas sauter à la ligne
.writeLine "Message à ecrire 2"
.writeLine "Message à ecrire 3"
End With
msg = "Écriture réussie dans fichier.txt"
MsgBox (msg)



là, il ecrit ce que je lui dis..
quel est le code pour aller chercher des cellules ?

j'avais essayé ça :

Print , ActiveSheet("AS9").Value

mais ça marche pas ...
 

job75

XLDnaute Barbatruc
Re : Extraire certaines données EXCEL vers Fichiers TXT

Bonjour benny47,

Le fichier sur cjoint est un fichier .mtg mais bon, je l'ai transformé...

Téléchargez les fichiers joints (dans le même dossier).

La macro est dans le fichier Pilote(1) :

Code:
Sub TXT()
Dim i As Long, p As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Open(ThisWorkbook.Path & "\Fichier txt.txt").Sheets(1)
  For i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 To 2 Step -1
    p = InStr(.Cells(i - 1, 1), "=")
    If p Then
      .Rows(i).Insert
      .Cells(i, 1) = Mid(.Cells(i - 1, 1), p + 1)
      .Cells(i - 1, 1) = Left(.Cells(i - 1, 1), p)
    End If
  Next
  .Parent.SaveAs .Parent.Path & "\" & .Parent.Name, xlText
  .Parent.Close
End With
End Sub
A+
 

Pièces jointes

  • Fichier txt(1).zip
    19.8 KB · Affichages: 34

job75

XLDnaute Barbatruc
Re : Extraire certaines données EXCEL vers Fichiers TXT

Re,

Une amélioration pour éviter d'insérer une ligne s'il n'y a plus rien après le signe = :

Code:
If p And p < Len(.Cells(i - 1, 1)) Then
Code:
Sub TXT()
Dim i As Long, p As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Open(ThisWorkbook.Path & "\Fichier txt.txt").Sheets(1)
  For i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 To 2 Step -1
    p = InStr(.Cells(i - 1, 1), "=")
    If p And p < Len(.Cells(i - 1, 1)) Then
      .Rows(i).Insert
      .Cells(i, 1) = Mid(.Cells(i - 1, 1), p + 1)
      .Cells(i - 1, 1) = Left(.Cells(i - 1, 1), p)
    End If
  Next
  .Parent.SaveAs .Parent.Path & "\" & .Parent.Name, xlText
  .Parent.Close
End With
End Sub
Dossier (2).

A+
 

Pièces jointes

  • Fichier txt(2).zip
    19.8 KB · Affichages: 31

benny47

XLDnaute Junior
Re : Extraire certaines données EXCEL vers Fichiers TXT

Merci beaucoup JOB75 !

Mais comment puis je faire pour inserer mes cellules copiés de différents endroits dans excel aprés les "=" ?

genre je voudrais inserer la cellule AS9 , puis la B3 etc ..

Mais sinon, c'est super !! ça m'avance vraiment beaucoup !!
Merci encore !
 

job75

XLDnaute Barbatruc
Re : Extraire certaines données EXCEL vers Fichiers TXT

Re,

en fait , pour écrire différentes cellules aprés certains champ dans le fichier texte ..
si tu y arrive, tu n'as qu'a faire qu'un exemple..je l'adapterais ..

Vous ne croyez pas que c'est à vous de donner un exemple ??? Et clair si possible :rolleyes:

En attendant, voici une autre solution, nettement plus rapide car elle utilise des tableaux :

Code:
Sub TXT()
Dim tablo, t, rest(), p As Integer, n As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Open(ThisWorkbook.Path & "\Fichier txt.txt").Sheets(1)
  tablo = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)(2))
  For Each t In tablo
    ReDim Preserve rest(n)
    p = InStr(t, "=")
    If p And p < Len(t) Then
      rest(n) = Left(t, p)
      n = n + 1
      ReDim Preserve rest(n)
      rest(n) = Mid(t, p + 1)
    Else
      rest(n) = t
    End If
    n = n + 1
  Next
  .[A1].Resize(n) = Application.Transpose(rest)
  .Parent.SaveAs .Parent.Path & "\" & .Parent.Name, xlText
  .Parent.Close
End With
End Sub
Mais attention : Application.Transpose accepte au maximum 65536 éléments.

Au delà il faut transposer élément par élément :

Code:
Sub TXT()
Dim tablo, t, rest(), p As Integer, n As Long, trans()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Workbooks.Open(ThisWorkbook.Path & "\Fichier txt.txt").Sheets(1)
  tablo = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)(2))
  For Each t In tablo
    ReDim Preserve rest(n)
    p = InStr(t, "=")
    If p And p < Len(t) Then
      rest(n) = Left(t, p)
      n = n + 1
      ReDim Preserve rest(n)
      rest(n) = Mid(t, p + 1)
    Else
      rest(n) = t
    End If
    n = n + 1
  Next
  '---transposition---
  ReDim trans(n - 1, 0)
  For n = 0 To n - 1
    trans(n, 0) = rest(n)
  Next
  .[A1].Resize(n) = trans
  .Parent.SaveAs .Parent.Path & "\" & .Parent.Name, xlText
  .Parent.Close
End With
End Sub
Dossiers (3) et (3 bis) joints.

Edit : durées d'exécution sur Win 7 - Excel 2010 :

- version (2) => 2,68 s

- version (3) => 0,40 s

- version (3 bis) => 0,25 s...

A+
 

Pièces jointes

  • Fichier txt(3).zip
    17.7 KB · Affichages: 25
  • Fichier txt(3 bis).zip
    20.5 KB · Affichages: 25
Dernière édition:

benny47

XLDnaute Junior
Re : Extraire certaines données EXCEL vers Fichiers TXT

Merci ! job75 ..
C'est vrai, mais le fichier d'origine ..est assez sensible .. ( Entreprise ) .. donc j'evite de le mettre sur le net ..
c'est pour ça que mes explications sont assez floues ..
J'en suis désolé et si j'avais pu lemettre, ça serait deja fait ..
Merci encore pour tout..

Je vais essayer cette soluce ..
 

benny47

XLDnaute Junior
Re : Extraire certaines données EXCEL vers Fichiers TXT

re, job75..
en fait, je ne vois pas ce que font tes derniers codes ?
j'ai beau ecrire des valeurs ou des abréviations dans les classeurs ,
quand je clique sur le bouton, le fichier txt, ne change pas ? ou alors je ne vois pas ...

J'espere ne pas trop etre chiant !..

merci
 

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088