Import Transfo simultanee .txt-.xls

alan

alan

XLDnaute Occasionnel
Bonjour a tous,

Je cherche a importer des donnees .txt dans un fichier excel. Chaque fichier text correspond a 1 jour (chaque ligne de ce fichier est 1 seconde).
Comme il y a plus de secondes dans un jour que de lignes dispo dans une feuille Excel, je suis oblige de couper en 2 mon fichier texte avant de l'importer puis de le traiter. Ce traitement est ensuite basique et ne consiste qu'a ne garder une ligne de donnees par minute 00:01:00, 00:02:00 (et donc eliminer les 00:01:36 par exemple)...ce que je fais pour l'instant a base de import moitie fichier txt, VLOOKUP et de copier/coller valeurs....
Le gros probleme est donc la grosseur du fichier text...Y a t il un moyen d'importer et de traiter en meme temps ce fichier txt pour que je puisse avoir mes donnees traitees directement et visible dans une feuille Excel (donnes qui dans ce cas la seront largement inferieurs a mon nombre de lignes).
Je voudrai a long terme classer les donnees d'un mois dans un seule feuille...(60*24*30=43200 lignes pour 1 mois)
Voila je ne sais pas si c'est possible...
Merci de votre aide...
 

Pièces jointes

  • essai.zip
    15.5 KB · Affichages: 27
  • Alan_original.xls
    13.5 KB · Affichages: 52
  • essai.zip
    15.5 KB · Affichages: 23
  • essai.zip
    15.5 KB · Affichages: 27
Trier par date Trier par votes
G

GIBI

XLDnaute Impliqué
Re : Import Transfo simultanee .txt-.xls

Bonjour,

voici une macro qui lit le fichier et enregistre dans excel la première ligne de chaque date/HH/MM



Sub Lire()

Dim FichierE As String

FichierE = InputBox("Nom du fichier à charger", , "D:\Temp\essai-1\essai.txt")
If FichierE = "" Then Exit Sub

debut = Time
Open FichierE For Input As #1
'traiter la ligne titre
lig = 1
Line Input #1, Entrée
Valeur = Split(Entrée, vbTab)
For i = 0 To UBound(Valeur)
Cells(lig, i + 1) = Valeur(i)
Next


'Traiter le fichier
While Not EOF(1)
Line Input #1, Entrée
Valeur = Split(Entrée, vbTab)
If Format(Valeur(0), "yy/mm/dd/hh:mm") <> ValeurPrec Then
lig = lig + 1
For i = 0 To UBound(Valeur)
Cells(lig, i + 1) = Valeur(i)
Next
ValeurPrec = Format(Valeur(0), "yy/mm/dd/hh:mm")
End If

Wend

Close #1
fin = Time

MsgBox ("le fichier " & Fichiers & " a été traité en " & Format(fin - debut, "h:mm:ss"))

End Sub

Amuse-toi

GIBI
 

Pièces jointes

  • lireFic.xls
    28.5 KB · Affichages: 56
  • lireFic.xls
    28.5 KB · Affichages: 57
  • lireFic.xls
    28.5 KB · Affichages: 56
Dernière édition:
Vote positif 0 Vote négatif
SergiO

SergiO

XLDnaute Accro
Re : Import Transfo simultanee .txt-.xls

Bonjour,

Le code ci-dessous permet d'écrire toutes les minutes du fichier Txt.

Code: 
Sub Traitement()
Dim Fichier As String, Chemin As String
Dim LigneTxt
Dim X As Integer, L As Integer

Chemin = "C:\" ' à adapter
Fichier = "essai.txt" ' à adapter

L = Range("A65536").End(xlUp).Row + 1

Open Chemin & Fichier For Input As #1

Do While Not EOF(1)
Line Input #1, LigneTxt
Nb = X Mod 60
If Nb = 1 Then
    Cells(L, 1) = Mid(LigneTxt, 1, 19)
    gs = Mid(LigneTxt, 20, 10)
    gs = Replace(gs, Chr(9), "")
    gs = Replace(gs, Chr(32), "")
    Cells(L, 2) = gs
    L = L + 1
End If

X = X + 1
Loop

Close #1

End Sub

Bon test

@+
 
Vote positif 0 Vote négatif
alan

alan

XLDnaute Occasionnel
Re : Import Transfo simultanee .txt-.xls

Merci GIBI, SergiO

Ca fonctionne tres bien...celle de SergiO cependant m'affiche un "overflow" et ne m'affiche qu'une partie des donnees...ca vient peut etre de chez moi.
Si on poussait le vice, pensez vous qu'il soit possible d'adapter ce code pour qu'il me prenne en compte plusieurs fichiers txt du meme repertoire (par.ex, essai1.txt, essai2.txt, essai3.txt....), qu'il m'effectue la transfo et les range ensuite, sur la meme feuille, par date croissante par exemple...?
Dans tous les cas, merci pour votre aide....
 
Vote positif 0 Vote négatif
G

GIBI

XLDnaute Impliqué
Re : Import Transfo simultanee .txt-.xls

Alan,

J'ai ajouté en chapeau le traitement de tous les fichiers *.TXT d'un directory

Attention : la macro initialise d'abord la feuille excel ===> mettre commentaire les lignes


Sub Lire()

' à mettre en commentaire pour ne pas réinitialiser = 5 lignes
Cells.ClearContents 'initialisation de la feuille
Cells(1, 1).Value = "TIME"
Cells(1, 2).Value = "G/S"
Cells(1, 3).Value = "100nV"
Cells(1, 4).Value = "m/s"

Chemin = InputBox("Directory à lister", , "D:\Temp\essai-1")
If Chemin = "" Then: Exit Sub

debut = Time

'Liste des fichiers
Set fs = Application.FileSearch

With fs
.NewSearch
.LookIn = Chemin
.SearchSubFolders = True
.Filename = "*.TXT"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For L = 1 To .FoundFiles.Count
Fic = .FoundFiles(L)
Call ListeFichier(Fic) ' <=== lecture de chaque fichier
Next L
Else
MsgBox "Je n'ai trouvé aucun fichier"
End If
End With

fin = Time
MsgBox ("le fichier " & Fichiers & " a été traité en " & Format(fin - debut, "h:mm:ss"))

End Sub

Attention : travail sur la feuille active et aucune variable n'est déclarée (ce n'est pas joli mais cela fonctionne)


à customiser suivant tes besoins

GIBI

BONUS :

si tu veux trier en automatique sur la date ajoute

Range("A1").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveWindow.SmallScroll Down:=36

avant l'instruction Fin=time de "SUB Lire"
 

Pièces jointes

  • lireFic.xls
    39 KB · Affichages: 54
  • lireFic.xls
    39 KB · Affichages: 55
  • lireFic.xls
    39 KB · Affichages: 54
Dernière édition:
Vote positif 0 Vote négatif
SergiO

SergiO

XLDnaute Accro
Re : Import Transfo simultanee .txt-.xls

Re,

Voici ma version mise à jour

Code: 
Sub Traitement()
Dim Fichier As String, Chemin As String
Dim LigneTxt
Dim X, L As Integer

Application.ScreenUpdating = False
Chemin = "C:\" ' à adapter
Fichier = Dir(Chemin & "\\*.txt", 0)


L = Range("A65536").End(xlUp).Row + 1

Do While Len(Fichier) > 0

Open Chemin & Fichier For Input As #1

Do While Not EOF(1)
Line Input #1, LigneTxt
Nb = X Mod 60
If Nb = 1 Then
    Cells(L, 1) = Mid(LigneTxt, 1, 19)
    gs = Mid(LigneTxt, 20, 10)
    gs = Replace(gs, Chr(9), "")
    gs = Replace(gs, Chr(32), "")
    Cells(L, 2) = gs
    Cells(L, 3) = Fichier 'A enlever si besoin
    L = L + 1
End If

X = X + 1
Loop

Close #1
X = 0
Fichier = Dir()
Loop

'Tri des données
Range("A1:C" & L).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

@+
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Import Transfo simultanee .txt-.xls

Bonjour a tous

J'arrive un peu comme les carabiniers mais puisque c'est fait !!

Ma version (suppose le fichier txt dans le même repertoire que le fichier xls)

Code: 
Sub test()
ligne = 1
 Open ThisWorkbook.Path & "\" & "essai.txt" For Input As #1
 Do While Not EOF(1)
  Line Input #1, chaine
    x = Split(chaine, Chr(9))
     If x(0) = "TIME" Or Right(x(0), 2) = 0 Then
      For z = 0 To UBound(x)
        Cells(ligne, z + 1) = x(z)
      Next z
       ligne = ligne + 1
     End If
 Loop
 Close #1
End Sub
 
Vote positif 0 Vote négatif
alan

alan

XLDnaute Occasionnel
Re : Import Transfo simultanee .txt-.xls

Re GIBI, SergiO et pierrjean

Merci beaucoup, c impeccable et redoutablement efficace...Par contre, le code de sergiO m'affiche le nom du fichier txt dans les colonnes 3 et 4 au lieu des donnees...ce qui n'est pas tres grave car les donnees les plus importantes sont en colonne 2...
Question subsidiaire: le code est il ajustable aisement si je veux changer le pas d'echantionnage? cad au lieu d'1 data toutes les minutes, je n'en prendrai qu'une toutes les heures ou une toutes les 1/2 heure...
En gros, ce "pas" remet elle en cause la structure totale du code?
 
Vote positif 0 Vote négatif
SergiO

SergiO

XLDnaute Accro
Re : Import Transfo simultanee .txt-.xls

Re,

Dans mon code précédent, il y a un commentaire pour enlever le nom du fichier!

Voici mon code modifié pour saisir le pas d'échantillonnage:

Code: 
Sub Traitement()
Dim Fichier As String, Chemin As String
Dim LigneTxt
Dim X, L As Integer

Application.ScreenUpdating = False
Chemin = "C:\" ' à adapter
Fichier = Dir(Chemin & "\\*.txt", 0)


L = Range("A65536").End(xlUp).Row + 1
Pas = InputBox("Choix du pas d'échantillonnage (exprimé en secondes) : ", "Traitement de données", "60")
If Pas = "" Then Exit Sub
Do While Len(Fichier) > 0

Open Chemin & Fichier For Input As #1

Do While Not EOF(1)
Line Input #1, LigneTxt
Nb = X Mod Pas
If Nb = 1 Then
    Cells(L, 1) = Mid(LigneTxt, 1, 19)
    gs = Mid(LigneTxt, 20, 10)
    gs = Replace(gs, Chr(9), "")
    gs = Replace(gs, Chr(32), "")
    Cells(L, 2) = gs
    L = L + 1
End If

X = X + 1
Loop

Close #1
X = 0
Fichier = Dir()
Loop

'Tri des données
Range("A1:C" & L).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

@+
 
Vote positif 0 Vote négatif
alan

alan

XLDnaute Occasionnel
Re : Import Transfo simultanee .txt-.xls

Re SergiO,

C exactement ce qu'il me fallait...merci beaucoup...un petit hic cependant...a 1 pas de 60s, il me renvoie un message d'erreur: "Run Time error '6' Overflow " et me souligne L=L+1 dans le code....
J'ai essaye avec un pas de 75s (et plus) et ca marche tres bien...comme si 60s etait un pas trop fin pour lui....connaitrais tu l'origine de ce probleme?
Merci encore
 
Vote positif 0 Vote négatif
SergiO

SergiO

XLDnaute Accro
Re : Import Transfo simultanee .txt-.xls

Re,

Essaie d'enlever ce qui est en rouge

Code: 
Sub Traitement()
Dim Fichier As String, Chemin As String
Dim LigneTxt
Dim X, L [COLOR=red][B]As Integer[/B][/COLOR]
[COLOR=black]'...[/COLOR]

@+
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Import Transfo simultanee .txt-.xls

Re

Essentiellement pour rappeler que moi c'est Pierrejean !!!
Mais puisque je suis la ....
ma version avec entrée du pas

Code: 
Sub test()
y = InputBox("Pas en secondes SVP ?")
ligne = 1
 Open ThisWorkbook.Path & "\" & "essai.txt" For Input As #1
 Do While Not EOF(1)
  Line Input #1, chaine
    x = Split(chaine, Chr(9))
     If x(0) = "TIME" Then
      For z = 0 To UBound(x)
        Cells(ligne, z + 1) = x(z)
      Next z
       ligne = ligne + 1
    Else
    w = (CDbl(CDate(x(0))) * 86400) / CDbl(y)
    If w - Int(w) < 0.000001 Then
    For z = 0 To UBound(x)
        Cells(ligne, z + 1) = x(z)
      Next z
       ligne = ligne + 1
    End If
    End If
 Loop
 Close #1
End Sub
 
Vote positif 0 Vote négatif
alan

alan

XLDnaute Occasionnel
Re : Import Transfo simultanee .txt-.xls

Ahahah... je suis desole pierrejean...j'ai voulu aller trop vite...tu m'en veux pas??;)
Je te remercie pour ce nouveau code, il filtre les donnees tres rapidement je trouve...c un avantage!
merci encore
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Tri et Import
Réponses
4
Affichages
184
Le Rouky
L
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
198
sylvanu
sylvanu
C
  • Question
Microsoft 365 copier coller en changeant la disposition et plage de donnees variable
Réponses
5
Affichages
459
cg1980
C
T
  • Résolu(e)
XL 2019 Logger les modifications faites sur un autre classeur
Réponses
5
Affichages
177
ThierryP
T
B
  • Résolu(e)
Microsoft 365 bug dans une formule
Réponses
11
Affichages
511
BOILEAU
B
D
  • Question
Microsoft 365 Chemin accès PowerQuery
Réponses
2
Affichages
297
Derrdio
D
A
  • Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
509
aurelio.ewane
A
I
  • Résolu(e)
Microsoft 365 [RESOLU] Boucler sur une partie de code
Réponses
5
Affichages
411
Icedarts
I
Y
  • Question
probléme au niveau mon code vba
Réponses
3
Affichages
114
Dranreb
Dranreb
L
  • Question
XL 2013 Macro pour exporter sur excel certaines données d'un fichier txt
Réponses
1
Affichages
415
sylvanu
sylvanu

Membres actuellement en ligne

3 membres et 30 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 321
Messages
2 087 266
Membres
103 501
dernier inscrit
talebafia