macro d'importation txt et date

J

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
Trier par date Trier par votes
cbea

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
 
Vote positif 0 Vote négatif
cbea

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
 
Vote positif 0 Vote négatif
cbea

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
 
Vote positif 0 Vote négatif
cbea

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
 
Vote positif 0 Vote négatif
J

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
 
Vote positif 0 Vote négatif
Staple1600

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:
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
Microsoft 365 Couper Coller Fichiers en VBA
Réponses
3
Affichages
476
patricktoulon
patricktoulon
L
  • Question
Autres Copier des données d’un fichier sans l’ouvrir juste en le sélectionnant via un UserForm
Réponses
6
Affichages
532
Liner77
L
T
  • Question
XL 2016 Code VBA sous un macos
Réponses
4
Affichages
367
telemarrk
T
T
  • Question
XL 2019 Débute en vba, exécuter mon code dans une cellule précise
2
Réponses
22
Affichages
771
telemarrk
T
E
  • Question
XL 2016 Imports données fichier txt
Réponses
2
Affichages
901
Bernard_XLD
Bernard_XLD
luke3300
  • Question
Microsoft 365 Erreur de macro
Réponses
4
Affichages
603
luke3300
luke3300
H
  • Résolu(e)
XL 2013 VBA IMPORT .txt dans 5 lignes
Réponses
3
Affichages
856
Hotburn
H
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
576
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Question
XL 2013 Comment charger une combobox avec le nom des dossiers
Réponses
2
Affichages
337
patricktoulon
patricktoulon
T
  • Question
XL 2019 pb de restitution de date
Réponses
2
Affichages
468
Phil69970
Phil69970

Membres actuellement en ligne

6 membres et 26 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
313 344
Messages
2 097 336
Membres
106 916
dernier inscrit
Soltani mohamed