VBA : Mise en forme d'un fichier.txt importé sur Excel.

Version imprimable

Bonjour,
J'ai une macro qui me permet d'importer un fichier texte dans un fichier excel, cependant lorsque j'ai un nombre décimal à plus de 3 chiffres significatif la virgule disparaît. Ce qui fausse mon résultat une fois ma macro exécuté. (ex : au lieu de 4,994 j'ai 4994).
Je laisse mon code ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
Sub Test()
Extraction "C:\Users\stagiaire.production\Documents\FichierSortie.txt", 65536, vbTab
End Sub
 
 
Sub Extraction(Fichier As String, NbLignesParFeuille As Long, Separateur As Variant)
Dim Chemin As String
Dim Tableau() As String
Dim ContenuLigne As String
Dim Counter As Double
Dim Tr As Worksheet, Tr2 As Worksheet, EC As Worksheet
Dim intLng As Integer, intDeb As Integer, intCol As Integer
Dim i As Integer
Set Tr = Sheets("Travail")
Set Tr2 = Sheets("Travail2")
Set EC = Sheets("En cours")
    Tr.Columns("A:Z").ClearContents
    Tr2.Columns("A:Z").ClearContents
    EC.Range("A4:Z65000").ClearContents
    Application.ScreenUpdating = False
    Counter = 1
      'Ouverture du fichier txt
    Open Fichier For Input As #1
        Do While Not EOF(1)
                If Counter > NbLignesParFeuille Then
                Counter = 1
                End If
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, ";")
            Tr.Activate
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = Tableau(i)
            Next i
            Counter = Counter + 1
        Loop
    Close #1
    Application.ScreenUpdating = True
 
End Sub

Merci

30/06/2017, 12h42
Menhir

Plutôt que de passer par une lecture de fichier séquentielle, il serait plus simple de passer par la méthode OpenText de l'objet Workbooks.
https://msdn.microsoft.com/en-us/vba...t-method-excel

Cette méthode propose des paramètres comme DecimalSeparator et ThousandsSeparator (plus quelques autres tout aussi pratiques) qui devraient résoudre ton problème.

bonjour,

Code:

ActiveSheet.Cells(Counter, i + 1) =TrouveType(Tableau(i))

Code:

1
2
3
4
5
6
Function TrouveType(V)
TrouveType = Replace(Replace(V, " ", ""), Chr(34), "")
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function 
End Function

Citation:

Envoyé par Menhir

Plutôt que de passer par une lecture de fichier séquentielle, il serait plus simple de passer par la méthode OpenText de l'objet Workbooks.
https://msdn.microsoft.com/en-us/vba...t-method-excel

Cette méthode propose des paramètres comme DecimalSeparator et ThousandsSeparator (plus quelques autres tout aussi pratiques) qui devraient résoudre ton problème.

Je t'avouerai que le code que j'ai, c'est une adaptation d'un code trouvé sur internet et de ce fait, je m'y connais pas beaucoup en importation de fichier texte.
J'ai cependant mi les DecimalSeparator et ThousandsSeparator dans ma boucle :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
    Open Fichier For Input As #1
        Do While Not EOF(1)
                If Counter > NbLignesParFeuille Then
                Counter = 1
                End If
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, ";")
            Tr.Activate
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = Tableau(i)
                Application.DecimalSeparator = ","
                Application.ThousandsSeparator = ","
                Application.UseSystemSeparators = False
            Next i
            Counter = Counter + 1
        Loop

Mais le séparateur mais une virgule au mauvaise endroit (ex : J'ai 720,395 au lieu de 7,20395)

Sur mon fichier Excel je suis en train de faire une mise à jour des macros qui n'était plus bonne, l'ancienne personne importé son fichier texte de cette manière :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
    NomFichier = ThisWorkbook.Path & "\Dossier\FichierSortie.txt"
    If Dir(NomFichier) <> "" Then   ''Test de l'existence du fichier
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & NomFichier, Destination:=Range("A1"))
            .Name = DateFichier
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 65001
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If

Cependant une fois sur deux le fichier ne se mettait pas dans les bonnes cases, les nombres étaient séparés dans plusieurs cases.

@dysorthographie Peux-tu m'expliquer ton code car je ne vois pas où tu veux en venir ?

tu poses une question et je pense répondre correctement, voilà ou je veux en venir!

fais au moins teste!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
OptionExplicit
Sub Test()
Extraction "C:\Users\stagiaire.production\Documents\FichierSortie.txt", 65536, vbTab
End Sub
 
 
Sub Extraction(Fichier As String, NbLignesParFeuille As Long, Separateur As Variant)
Dim Chemin As String
Dim Tableau() As String
Dim ContenuLigne As String
Dim Counter As Double
Dim Tr As Worksheet, Tr2 As Worksheet, EC As Worksheet
Dim intLng As Integer, intDeb As Integer, intCol As Integer
Dim i As Integer
Set Tr = Sheets("Travail")
Set Tr2 = Sheets("Travail2")
Set EC = Sheets("En cours")
    Tr.Columns("A:Z").ClearContents
    Tr2.Columns("A:Z").ClearContents
    EC.Range("A4:Z65000").ClearContents
    Application.ScreenUpdating = False
    Counter = 1
      'Ouverture du fichier txt
    Open Fichier For Input As #1
        Do While Not EOF(1)
                If Counter > NbLignesParFeuille Then
                Counter = 1
                End If
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, ";")
            Tr.Activate
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = TrouveType(Tableau(i))
            Next i
            Counter = Counter + 1
        Loop
    Close #1
    Application.ScreenUpdating = True
  EndSub

Function TrouveType(V)
TrouveType = Replace(Replace(V, " ", ""), Chr(34), "")
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
  End Function

Citation:

Envoyé par dysorthographie

tu poses une question et je pense répondre correctement, voilà ou je veux en venir!

fais au moins teste!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
OptionExplicit
Sub Test()
Extraction "C:\Users\stagiaire.production\Documents\FichierSortie.txt", 65536, vbTab
End Sub
 
 
Sub Extraction(Fichier As String, NbLignesParFeuille As Long, Separateur As Variant)
Dim Chemin As String
Dim Tableau() As String
Dim ContenuLigne As String
Dim Counter As Double
Dim Tr As Worksheet, Tr2 As Worksheet, EC As Worksheet
Dim intLng As Integer, intDeb As Integer, intCol As Integer
Dim i As Integer
Set Tr = Sheets("Travail")
Set Tr2 = Sheets("Travail2")
Set EC = Sheets("En cours")
    Tr.Columns("A:Z").ClearContents
    Tr2.Columns("A:Z").ClearContents
    EC.Range("A4:Z65000").ClearContents
    Application.ScreenUpdating = False
    Counter = 1
      'Ouverture du fichier txt
    Open Fichier For Input As #1
        Do While Not EOF(1)
                If Counter > NbLignesParFeuille Then
                Counter = 1
                End If
            Line Input #1, ContenuLigne
            Tableau = Split(ContenuLigne, ";")
            Tr.Activate
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = TrouveType(Tableau(i))
            Next i
            Counter = Counter + 1
        Loop
    Close #1
    Application.ScreenUpdating = True
  EndSub

Function TrouveType(V)
TrouveType = Replace(Replace(V, " ", ""), Chr(34), "")
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
  End Function

Excuse moi je me suis mal exprimé, j'ai fait le test mais j'ai le même problème qu'avec l'autre méthode, il ne prend pas en compte la virgule au bon endroit.
Cependant j'ai du mal à comprend comment ta fonction, fonctionne avec les IsDate ?

30/06/2017, 16h32
Menhir

Citation:

Envoyé par MLvba

je m'y connais pas beaucoup en importation de fichier texte.

Tout est dans le lien que j'ai donné : syntaxe, explications et exemple.

Une fois que ton fichier texte est devenu un fichier Excel, il est bien plus simple de transférer les bonnes valeurs dans les bonnes cases.