Macro - Import de plusieurs fichiers textes

[culturebeach]

Bonjour a tous,

Je travaille actuellement sur un logiciel de calcul de contraintes dans les structures (ANSYS) qui me sort les resultats sous la forme de fichiers textes.
Je recupere ces fichiers dans un dossier et mon But, c'est d'arreter le copier/coller dans excel.

1) J'aimerais donc que tous mes fichiers soient copies sous excel dans un seul worksheet
2) J'ai ensuite un probleme car seule une partie de ces fichiers m'interesse (environ les 200 premieres lignes)

J'ai trouve la macro ci dessous en cherchant sur le forum.. mais cela me sors tous les fichiers a l'affilade dans une meme colonne... or les fichiers font des milliers de lignes donc cela bloque en bas (Max de ligne est atteint)

Sub Import_Text()
Dim Directory As String, File As String, Temp As String
Dim NumRow As Long, NumCol As Integer
Dim FF As Integer, I As Integer

Directory = "C:\test\"
File = Dir(Directory & "*.txt")
NumRow = ActiveCell.Row
NumCol = ActiveCell.Column
With ActiveSheet
FF = FreeFile
Do While File <> ""
Open Directory & File For Input As #FF
Do While Not EOF(FF)
Line Input #FF, Temp
Table = Split(Temp, vbTab)
For I = 0 To UBound(Table)
.Cells(NumRow, NumCol + I) = Table(I)
Next
NumRow = NumRow + 1
Loop
Close #FF
File = Dir
Loop
End With
End Sub


Etant debutant VBA, je ne comprends pas tout le code au dessus, Je suis ouvert a toute idee !!
Merci

 

[RENAUDER]

Re : Macro - Import de plusieurs fichiers textes

Bonjour,

Voici un exemple de code que j'avais. Il n'est pas de moi mais je crois me souvenir de l'avoir utilisé dans le cadre d'un fichier avec une acquisition de valeurs tous les 0.05 secondes donc avec beaucoup de données. Si cela peut t'aider ?

'remplit 65000 lignes)

'Sören Lindqvist, mpep
Sub ImportLargefile()

'Dimension Variables
Dim ResultStr As String
Dim FileName As String
Dim FileNum As Integer
Dim Counter As Double
    ChDrive "C:"
    ChDir "C:\Excel\Recuit contacts"
    MyFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    If VarType(MyFile) = vbBoolean Then
        Exit Sub
    Else

  'FileName = "C:\excel\recuit contacts\01091663.txt"
  'If you want an inputbox use the below:
  'InputBox("Write name of file and path")

  'If FileName = "" Then End
  FileNum = FreeFile()
  Open MyFile For Input As #FileNum
  End If
  Application.ScreenUpdating = False

  Workbooks.Add template:=xlWorksheet

  Counter = 1

  Do While Seek(FileNum) <= LOF(FileNum)

    Application.StatusBar = "Import données " & _
      Counter & " depuis fichier texte " & FileName
      Line Input #FileNum, ResultStr
      If Left(ResultStr, 1) = "=" Then
        ActiveCell.Value = "'" & ResultStr
      Else
        ActiveCell.Value = ResultStr
      End If

    If ActiveCell.Row = 65500 Then
    ' I'll need some space below
    'If file is larger than (65500.st)
      ActiveWorkbook.Sheets.Add
    Else
      ActiveCell.Offset(1, 0).Select
    End If
    Counter = Counter + 1

  Loop
  Close
  Application.StatusBar = False
End Sub

 

[BOISGONTIER]

Re : Macro - Import de plusieurs fichiers textes

Bonjour,

Import de fichiers .txt (séparateur Tabulation)

Sub Import2()
  nf = Dir("*.txt")    ' premier fichier texte
  i = 1
  Do While nf <> ""
    Open "import.txt" For Input As #1
    If témoinTitre Then Line Input #1, ligne
    Do While Not EOF(1)
      Line Input #1, ligne
      temp = Split(ligne, vbTab)
      Cells(i, 1).Resize(1, UBound(temp)) = temp
      i = i + 1
    Loop
    Close #1
    nf = Dir               ' fichier suivant
    témoinTitre = True
  Loop
End Sub

JB

 

[culturebeach]

Re : Macro - Import de plusieurs fichiers textes

Bonjour !

Tout d'abord, merci beaucoup de ta reponse. J'ai regarde le code que tu m'as donne avec attention.
En fait, me donnees ne depsassent pas les 62000 lignes mais en revanche quand je me retrouve avec 20 fichiers de 62000 lignes qui s'ouvrent dans la meme colonne a la suite, cela bloque avec le code que j'ai trouve ci-dessus.

je voudrais que chaque fichier soit insere par exemple a partir des cellules A1 puis L1 etc... (en gros espacees suffisemment)

Pour comprendre mieux : je te joins une image de "l'architecture" visee

 

[culturebeach]

Re : Macro - Import de plusieurs fichiers textes

lol , je te remercie Boisgontier de ton mail, j'etais en train d'ecrire au mail precedent de Renauder, donc je regarde aussi ce code !

 

[culturebeach]

Re : Macro - Import de plusieurs fichiers textes

Alors, j'ai regarde et, probablement du a mon manque de connaissances sur le sujet, je ne comprends pas le code.
J'ai essaye de le reprendre avec mes contraintes a savoir :
- je dispose de plusieurs fichiers dans un dossier
- je veux les ouvrir en une fois
- il doivent apparaitrent dans le meme worksheet et qu'ils soient espaces par quelques colonnes entre chaque fichier



Sub Import2()

Dim Directory As String, ligne As String
Dim I As Integer
Directory = "C:\test\"
nf = Dir(Directory & "*.txt") ' premier fichier texte
I = 1
Do While nf <> ""
Open Directory & nf For Input As #1
If temoinTitre Then Line Input #1, ligne
Do While Not EOF(1)
Line Input #1, ligne
Temp = Split(ligne, vbTab)
Cells(I, 1).Resize(1, UBound(Temp)) = Temp I = I + 1
Loop
Close #1
nf = Dir ' fichier suivant
temoinTitre = True
Loop
End Sub

Mais cela bloque sur la ligne en orange
De plus c'est quoi la variable temointitre?

Merci en tout cas de l'aide !

 

[culturebeach]

Re : Macro - Import de plusieurs fichiers textes

Bonjour a tous !

J'ai revu mon probleme et j'ai decide de le traiter d'une autre facon.

En fait je n'ai besoin dans chaque fichier texte que des lignes comprises entre la 7eme ligne et la ligne vide suivante. Cette ligne vide ne depasse pas la 210 eme ligne et je n'ai pas besoin des 60 000 lignes suivantes.
Donc je trouve cela peu judicieux de ma part de vouloir faire une copie inutile et longue.

Par consequent en reprenant le premier code, j'essaye d'inserer deux conditions :

-commencer la copie du fichier texte a partir de la 7 eme ligne
-arreter la copie de chaque fichier sur la ligne vide suivante.

En fait, je pense que cela puisse resoudre le probleme
De plus comme ca
-il me serait impossible d'atteindre les 65000 lignes (j'aurais jamais 200 fichiers a traiter, au plus une vingtaine)
-je gagnerais en temps de copie
-ce sera facile de faire un classement sur la colonne qui m'interesse !

Voila donc si vous avez des suggestions sur les deux lignes en rouge, pour les inclure dans le premier code, je suis preneur

Merci !

 

[culturebeach]

Re : Macro - Import de plusieurs fichiers textes

Après avoir lu les conseils que l'on m'a donné, j'ai fait un tour sur les sites de Polykromy Excel - Cours - Astuces - Macros - Trucs - Applications VBA et de Eric Renaud Exemples de programmation Excel VBA pour trouver les idées qui me manquaient pour résoudre mon probleme.

Je crois que je viens d'y arriver.
Voici le code que j'ai créé, je pense qu'il doit y avoir plus simple. En revanche, cela semble marcher pour mon utilisation. Il ne me reste que à faire des essais.

Le code :

Sub Import_Text()
Dim Directory As String, File As String, Temp As String
Dim NumRow As Long, NumCol As Integer
Dim FF As Integer, I As Integer, L As Integer
Application.ScreenUpdating = False


Directory = "C:\test\"
File = Dir(Directory & "*.tran")
NumRow = ActiveCell.Row
NumCol = ActiveCell.Column
With ActiveSheet
FF = FreeFile
Do While File <> ""
J = 0
Open Directory & File For Input As #FF

Do While Not EOF(FF)
Line Input #FF, Temp
Table = Split(Temp, vbTab)
For I = 0 To UBound(Table)
.Cells(NumRow, NumCol + I) = Table(I)
Next

If J > 6 Then
If Application.CountA(Rows(NumRow)) = 0 Then GoTo Nextfile
End If

J = J + 1
NumRow = NumRow + 1
Loop
Nextfile:
Close #FF
Rows(L + 1).Delete
Rows(L + 1).Delete
Rows(L + 1).Delete
Rows(L + 1).Delete
Rows(L + 1).Delete
Rows(L + 1).Delete
NumRow = NumRow - 6
L = NumRow - 1
File = Dir
Loop
End With
End Sub

Merci !