macro d'importation txt et date

jopont

XLDnaute Impliqué
Bonjour

j'utilise la macro suivante pour importer plusieurs fichiers txt en même temps dans une feuille excel.

Mon problème est le suivant, lorsqu'un j'importe dans le répertoire ""E:\fevrier08" par exemple, ou il y a autant de fichiers que de jours (0102.txt,0202.txt ...) l'importation ne se fait pas dans l'ordre des jours.

D'autre part les données importées des fichiers txt sont parfois erronées, j'ai des cellules avec date qui sont parfois fausses. exemple pour le 10/02/08 08:00, la donnée importée donne 02/10/08 08:00. Il y a une inversion sur certain jour.

Je joint le fichier excel avec deux fichiers txt.

merci pour votre aide

La macro :

Sub ouvrir()
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 = "G:\février08\"
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
 

Pièces jointes

  • macroimport.zip
    11.8 KB · Affichages: 32
  • macroimport.zip
    11.8 KB · Affichages: 34
  • macroimport.zip
    11.8 KB · Affichages: 30

cbea

XLDnaute Impliqué
Re : macro d'importation txt et date

Bonjour jopont,

Voici une solution (à tester) :

Code:
Sub import()
    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 = ThisWorkbook.Path & "\" & "fevrier08\"   ' "E:\fevrier08\"
    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)
[COLOR="Red"]                    If IsDate(Table(I)) Then
                        .Cells(NumRow, NumCol + I) = CDate(Table(I))
                    Else[/COLOR]
                        .Cells(NumRow, NumCol + I) = Table(I)
[COLOR="red"]                    End If[/COLOR]
                Next
                NumRow = NumRow + 1
            Loop
            Close #FF
            File = Dir
        Loop
    End With
End Sub
 

cbea

XLDnaute Impliqué
Re : macro d'importation txt et date

Bonjour jopont,

Peux-tu tester ce code ?

Code:
Sub import()
    Dim Directory As String, File As String, Temp As String
    Dim NumRow As Long, NumCol As Integer
    Dim FF As Integer, I As Integer
    [COLOR="Red"]Dim LigFic As Long[/COLOR]
    
    Directory = ThisWorkbook.Path & "\" & "fevrier08\"   ' "E:\fevrier08\"
    File = Dir(Directory & "*.txt")
    NumRow = ActiveCell.Row
    NumCol = ActiveCell.Column
    With ActiveSheet
        FF = FreeFile
        [COLOR="red"]LigFic = 0[/COLOR]
        Do While File <> ""
            Open Directory & File For Input As #FF
            Do While Not EOF(FF)
                [COLOR="red"]If LigFic > 4 Then[/COLOR]
                    Line Input #FF, Temp
                    Table = Split(Temp, vbTab)
                    For I = 0 To UBound(Table)
                        If IsDate(Table(I)) Then
                            .Cells(NumRow, NumCol + I) = CDate(Table(I))
                        Else
                            .Cells(NumRow, NumCol + I) = Table(I)
                        End If
                    Next
                    NumRow = NumRow + 1
                [COLOR="red"]End If
                LigFic = LigFic + 1[/COLOR]
            Loop
            Close #FF
            File = Dir
        Loop
    End With
End Sub
 

cbea

XLDnaute Impliqué
Re : macro d'importation txt et date

Bonsoir,

Une autre solution.

Code:
Sub import()
    Dim Directory As String, File As String, Temp As String
    Dim NumRow As Long, NumCol As Integer
    Dim FF As Integer, I As Integer
    Dim LigFic As Long
    
    Directory = ThisWorkbook.Path & "\" & "fevrier08\"   ' "E:\fevrier08\"
    File = Dir(Directory & "*.txt")
    NumRow = ActiveCell.Row
    NumCol = ActiveCell.Column
    With ActiveSheet
        FF = FreeFile
        LigFic = 0
        Do While File <> ""
            Open Directory & File For Input As #FF
            Do While Not EOF(FF)
                Line Input #FF, Temp
                If LigFic > 4 Then
                    Table = Split(Temp, vbTab)
                    For I = 0 To UBound(Table)
                        If IsDate(Table(I)) Then
                            .Cells(NumRow, NumCol + I) = CDate(Table(I))
                        Else
                            .Cells(NumRow, NumCol + I) = Table(I)
                        End If
                    Next
                    NumRow = NumRow + 1
                End If
                LigFic = LigFic + 1
            Loop
            LigFic = 0
            Close #FF
            File = Dir
        Loop
    End With
End Sub
 

cbea

XLDnaute Impliqué
Re : macro d'importation txt et date

Voici une nouvelle adaptation :
Code:
Sub import()
    Dim Directory As String, File As String, Temp As String
    Dim NumRow As Long, NumCol As Integer
    Dim FF As Integer, I As Integer
    Dim LigFic As Long
    
    Directory = ThisWorkbook.Path & "\" & "fevrier08\"   ' "E:\fevrier08\"
    File = Dir(Directory & "*.txt")
    NumRow = ActiveCell.Row
    NumCol = ActiveCell.Column
    With ActiveSheet
        FF = FreeFile
        LigFic = 0
        Do While File <> ""
            Open Directory & File For Input As #FF
            Do While Not EOF(FF)
                Line Input #FF, Temp
                If LigFic > 4 Then
                    Table = Split(Temp, vbTab)
                    For I = 0 To UBound(Table)
                        If IsDate(Table(I)) Then
                            .Cells(NumRow, NumCol + I) = CDate(Table(I))
                        Else
                            .Cells(NumRow, NumCol + I) = Table(I)
                        End If
                    Next
                    NumRow = NumRow + 1
                End If
                LigFic = LigFic + 1
            Loop
            ' Supprimer la dernière ligne
[COLOR="Red"]            If NumRow > ActiveCell.Row Then
                NumRow = NumRow - 1
                .Rows(NumRow & ":" & NumRow).Delete shift:=xlUp
            End If[/COLOR]            
            LigFic = 0
            Close #FF
            File = Dir
        Loop
    End With
End Sub
 

jopont

XLDnaute Impliqué
importation texte via une combo.

Bonjour, pour faire suite à ce post, j'aimerais savoir comment je pourrais intégrer une combo qui s'ouvre à l'exécution de la macro. dans cette combo j'aimerais un champ texte qui récupère le nom du fichier txt à importer.
Ceci m'éviterais de rentrer à chaque fois dans la macro pour changer le nom du fichier à importer.

merci
 

Staple1600

XLDnaute Barbatruc
Re : macro d'importation txt et date

Bonjour


Une piste à développer

Code:
Sub Nomdufichier()
'source:Daniel Josserand
Dim NomFichier
NomFichier = Application.GetOpenFilename
If VarType(NomFichier) = vbBoolean Then MsgBox "Action annulée" _
Else MsgBox "Fichier sélectionné : " & NomFichier
End Sub
 
Dernière édition:

Discussions similaires

Réponses
4
Affichages
524

Statistiques des forums

Discussions
312 147
Messages
2 085 767
Membres
102 968
dernier inscrit
Tmarti