Importation fichier
Bonjour à tous
J'ai trouvé la macro suivante , mais elle fait un saut de ligne dés qu'elle voit un chiffre avec une virgule??
14,2 j'ai 14 en A1 et 2 en A2, comprend pas .. si quelqu'un a un idée
Sub LireFichierTxt()
Dim Ligne As String, NoLigne As Long, NoCol As Integer
Dim Tableau, Chemin, NomFich
' Cells.Select
' Selection.ClearContents
Chemin = "C:\"
NomFich = "x.txt" 'ou .txt
i = 0
Open Chemin & NomFich For Input As #1
While Not EOF(1)
Input #1, Ligne
Tableau = Split(Ligne, "+") ' si le séparateur est un ";", sinon tu changes
NoLigne = NoLigne + 1
For NoCol = 0 To UBound(Tableau)
If (NoCol = 0 Or NoCol = 2) Then '(Importation colonnes A, C au format "texte")
Cells(NoLigne, NoCol + 1).NumberFormat = "@"
'les date à importer sont au format francais jj/mm/aaa dans le fichier txt, DONC
'en théorie nous devrions mettre pour la colonne A : NumberFormat="dd/mm/yyyy"
'mais, il ne faut surtout pas etre coherent !!!, mais plutot indiquer le format mm/dd/yyyy, pour que certaines dates ne soient pas inversées
End If
Cells(NoLigne, NoCol + 1).Value = Tableau(NoCol)
Next
Wend
Close #1
End SubMerci de votre aide
Bonjour,
Ne serait-il pas plus simple d'ouvrir le fichier texte dans un classeur par la méthode OpenText ?
Cordialement.
Merci MFerrand pour t'a réponse,j'ai essayer le code suivant
Workbooks.OpenText Filename:="C:\xls\Classeur1.xls", StartRow:=1, _
DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter _
:=False, Semicolon:=True, DecimalSeparator:="."mon problème vient de l'importation des dates , avec le code ci-dessus les dates sont inversées entre le mois et le jours
a la base j'utilise le code suivant pour importer mes fichiers txt mais celui ci inverse aussi les dates
Function Lire(ByVal NomFichier As String)
Dim Chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
' Séparateur Tabulation
Separateur = "+"
'Cells.Clear
NumFichier = FreeFile
iRow = 1
Open NomFichier For Input As #NumFichier
Do While Not EOF(NumFichier)
iCol = 1
Line Input #NumFichier, Chaine
Ar = Split(Chaine, Separateur)
For i = LBound(Ar) To UBound(Ar)
Sheets("Import").Cells(iRow, iCol) = Ar(i)
iCol = iCol + 1
Next
iRow = iRow + 1
Loop
Close #NumFichier
End Functiontoujours ces problèmes de dates entre format français et anglais
Greg
bonjour
sans voir ton fichier txt ses dur de te répondre
A+
Maurice
Le paramètre FieldInfo permet de définir comment analyser des formats de dates... A essayer !
re,
Voici un fichier texte en exemple, quand je l'importe avec ma fonction "lire" il inverse les dates, quand je l'importe avec la macro "LireFichierTxt" il ne m'inverse pas les dates mais prend les ","comme saut de ligne et avec OpenText il inverse aussi les dates!!
Merci encore pour t'on aide
Greg
Sur ce fichier :
Sub OuvrirTxt()
Workbooks.OpenText "E:\Documents\___exemple.txt", xlWindows, , xlDelimited, _
xlTextQualifierNone, other:=True, otherchar:="+", fieldinfo:=Array(Array(1, 4)), _
DecimalSeparator:=","
End SubNom du fichier et chemin à remplacer...
Bonjour
voila une macro pour ton modèle de fichier TXT
tu lance ChoixFicTxt
A+
Maurice
Private Sub ChoixFicTxt()
Dim dossier As FileDialog
ChoixChemin = ActiveWorkbook.Path & Application.PathSeparator
Set dossier = Application.FileDialog(msoFileDialogFilePicker)
With dossier
.AllowMultiSelect = False
.InitialFileName = ChoixChemin
.Title = "Choix d'un fichier TXT"
.Filters.Clear
.Filters.Add "Fichier Csv ", "*.txt*", 1
If .Show = -1 Then
Chemin = .SelectedItems(1)
LireMan Chemin
End If
End With
Set dossier = Nothing
End Sub
Sub LireMan(NomFichier)
Dim Ar() As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With
Rows("1:" & Rows.Count).Clear
Sep = "+"
Lig = 1
' -----------------------------------------
On Error Resume Next
Open NomFichier For Input As #1
Do While Not EOF(1)
Line Input #1, Chaine
Ar = Split(Chaine, Sep)
Col = 1
For X = LBound(Ar) To UBound(Ar)
Select Case Col
Case 1
If IsDate(Ar(X)) Then
Cells(Lig, Col).Value = CDate(Ar(X))
Else
Cells(Lig, Col).Value = Ar(X)
End If
Case Else
Tmp = Application.Trim(Ar(X))
If IsNumeric(Tmp) Then
Cells(Lig, Col).Value = CDbl(Tmp)
Else
Cells(Lig, Col).Value = Tmp
End If
End Select
Col = Col + 1
Next
Lig = Lig + 1
Loop
Close #1
' -----------------------------------------
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.CutCopyMode = False
.Goto [A1], True
End With
End SubBonjour,
Merci à vous deux.
MAurice t'on code fonctionne parfaitement bien !! j'ai plus qu'a le décortiquer pour le comprendre.
Merci encore
bonne journée
Greg
Bonjour
petite modife car tu a des espace qui se balade
A+
Maurice
Sub LireMan(NomFichier)
Dim Ar() As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With
Rows("1:" & Rows.Count).Clear
Sep = "+"
Lig = 1
' -----------------------------------------
On Error Resume Next
Open NomFichier For Input As #1
Do While Not EOF(1)
Line Input #1, Chaine
Ar = Split(Chaine, Sep)
Col = 1
For X = LBound(Ar) To UBound(Ar)
Tmp = Application.Trim(Ar(X))
Select Case Col
Case 1
If IsDate(Tmp) Then
Cells(Lig, Col).Value = CDate(Tmp)
End If
If IsNumeric(Tmp) Then
Cells(Lig, Col).Value = CDbl(Tmp)
Else
Cells(Lig, Col).Value = Tmp
End If
Case Else
If IsNumeric(Tmp) Then
Cells(Lig, Col).Value = CDbl(Tmp)
Else
Cells(Lig, Col).Value = Tmp
End If
End Select
Col = Col + 1
Next
Lig = Lig + 1
Loop
Close #1
' -----------------------------------------
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.CutCopyMode = False
.Goto [A1], True
End With
End Sub