Import fichier txt plus de points

**Fvandermeulen** · 08/07/2009, 17h17

Bonjour à tous,

J'utilise une code qui me rapatrie un fichier texte dans Excel mais ce code traite ligne par ligne et champ par champ, comme j'arrive à des fichiers texte de +/- 90000 lignes et 99 colonnes, ça prend un temps fou.

J'ai donc adapté un code retrouvé sur la FAQ mais j'ai un soucis, cette méthode "supprime" les points et bien évidemment j'ai besoin des points.
Un des champs contient un chiffre d'affaire => si 1250.50 dans Excel 125050.
(Ne me dites pas de diviser par 100 car 1250.00 apparait dans le fichier texte comme 1250 )

Donc voici le code en question, si quelqu'un peu me renseigner sur l'élément à adapter afin que les "." soient maintenus dans Excel, je serais ravis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
47
48
49
50
51
52
53
Sub ImportTxt()
Dim Repertoire As String, Fichier As String
Dim NbWs As Integer, i As Integer
Dim strFullName As Variant
Dim Cn As Object, Rs As Object
 
'Sélection du ficher
strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub
 
Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) - (Len(Fichier) + 1))
 
'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Repertoire & ";" & _
    "Extended Properties=""text;HDR=Yes;FMT=Delimited"""
 
'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1
 
'boucle sur le résultat de la requete
While Not Rs.EOF
    'Ajout Feuille
    Worksheets.Add
    'Ecriture des données dans la feuille
    '65000 spécifie le nombre de lignes par feuille, xl2003 max absolu = 65536
    ActiveSheet.Range("A1").CopyFromRecordset Rs, 65000
Wend
 
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
 
NbWs = Worksheets.Count
For i = 1 To NbWs - 1
    Sheets(i).Move After:=Sheets(NbWs)
    Sheets(i).Name = "Data " & i
Next i
 
    Sheets("Parametres").Select
    ActiveSheet.Shapes("Button 1").Visible = False
    ActiveSheet.Shapes("Button 2").Visible = True
 
End Sub

D'avance merci

**CRACOS38** · 08/07/2009, 18h56

Salut,
Question idiote :
Avec les fonctions, Replace(), Format(), cstr() tu ne peut pas bidouiller ?

**ouskel'n'or** · 08/07/2009, 19h59

Une autre idée :
Un tableau est plus rapide à renseigner que des cellules.
Un range est un tableau à deux dimensions
Utiliser un tableau à deux dimensions pour faire transiter les données avant de les coller dans les feuilles de calculs tel un range.
Voici déjà le code pour coller les lignes du txt telles quelles. Après la ligne 65535 on change de feuille de calculs (tu sauras adapter pour les 90 feuilles ?

)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Test()
Dim ligne As String, tablo() as variant, i as long
    Worksheets("feuil1").Activate
    Open "D:\txt\Le Fichier.txt" For Input As #1
    Do While Not EOF(1)
        Do While (Not EOF(1)) And (i < 65536)
            i = i + 1
            ReDim Preserve tablo(1, i)
            Input #1, ligne
            tablo(0, i) = ligne
        Loop
        'On a atteint la ligne 65536 ou EOF, on colle le tableau
        Range("A1:A" & i) = Application.Transpose(tablo())
 
        'Si on n'a pas atteint la ligne 65536 c'est qu'on a eu EOF => On sort
        If i < 65536 Or EOF(1) Then Exit Do
        'Sinon on continue en redémarrant sur la ligne 1 d'une nouvelle feuille
        'Le tableau est redimensionné à 0 et i réinitialisé
        i = 0
        ReDim Preserve tablo(1, 0)
        'on change de feuille
        Worksheets("feuil2").Activate
    Loop
    Close #1
End Sub

Une explication : Seule la seconde dimension du tableau peut être redimensionnée. Malheureusement, cela renverse le tableau par rapport à un range -> Range(Ligne Colonne : DerniereLigne Colonne) au lieu de Range(Colonne Ligne : Colonne DerniereLigne) Heureusement, on peut transposer le tableau avec... Application.transpose.

Il restera à répartir les données dans les colonnes. Si tu donnes le séparateur de données utilisé, on pourra te proposer quelque chose.
Tu peux tester ça pour voir le résultat mais si le séparateur n'est pas un espace, tu devras le modifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub RépartitionDesDonnées()
    Columns("A").TextToColumns DataType:=xlDelimited, _
    ConsecutiveDelimiter:=True, Space:=True
End Sub

Tu testes la rapidité et tu choizes

Tu dis
Bonne soirée

Edit
PS - J'ajoute que TextToColumns permet de sélectionner le séparateur décimal

Envoyé par l'aide en ligne à TextToColumns

DecimalSeparator Argument de type String facultatif. Séparateur décimal utilisé par Microsoft Excel lors de la reconnaissance des nombres. Le paramètre par défaut est le paramètre du système.

**Fvandermeulen** · 09/07/2009, 08h04

Bonjour,
CRACOS38, merci mais le problème avec le code que j'ai montré c'est que je sais pas où/quand faire ce genre de manip.
C'est une manip que je fais dans l'autre code, qui ressemble à celui de Ouskel'nor mais je vais essayer cette proposition et vérifier si c'est plus rapide.
Merci.
A+

P.S. pour info le séparateur est ;

**ouskel'n'or** · 09/07/2009, 09h51

Envoyé par Fvandermeulen

P.S. pour info le séparateur est ;

Auquel cas tu devras préciser

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Columns("A").TextToColumns DataType:=xlDelimited, _
    ConsecutiveDelimiter:=True, Semicolon:=True, DecimalSeparator:="."

**Fvandermeulen** · 09/07/2009, 09h56

Boujour,
Ouskel'n'or, j'ai bloqué à la ligne avec une erreur13 Type mismatch

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1:A" & i) = Application.Transpose(tablo())

J'ai bêtement détourné le problème en faisant ligne par ligne comme mon code précédent faisait cellule par cellule celui ci est vachement plus rapide.

Voici l'ensemble de mon code avec la répartition par colonne intégré à la fin dans la boucle qui renomme les feuilles.
J'ai limité à 65500 pour pourvoir utiliser un end(xlup) dans la suite de mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ImportTxtNew()
Dim ligne As String, strFullName, i As Long, NbWs As Long
 
    Worksheets.Add
    strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")
 
    Open strFullName For Input As #1
 
    Do While Not EOF(1)
            Do While (Not EOF(1)) And (i < 65500)
                i = i + 1
                Input #1, ligne
                Cells(i, 1).Value = ligne
            Loop
        If i < 65500 Or EOF(1) Then Exit Do
            i = 0
            Worksheets.Add
    Loop
    Close #1
 
'Renomme les feuilles avec les données
NbWs = Worksheets.Count
For i = 1 To NbWs - 1
    If Sheets(i).Name = "Parametres" Then Resume Next
    Sheets(i).Columns("A").TextToColumns DataType:=xlDelimited, _
    semicolon:=True
    Sheets(i).Name = "Data " & i
Next i
 
    Sheets("Parametres").Select
    ActiveSheet.Shapes("Button 1").Visible = False
    ActiveSheet.Shapes("Button 2").Visible = True
    MsgBox "Import terminer, procédez à la Mise en forme"
End Sub

Merci A+

P.S. Si quelqu'un à la réponse à la question initiale, je suis preneur...

Edit: Désolé, j'ai collé le bon code et pas l'intermédiaire qui me servait de test

**ouskel'n'or** · 09/07/2009, 10h15

Envoyé par Fvandermeulen

Boujour,
Ouskel'n'or, j'ai bloqué à la ligne avec une erreur13 Type mismatch

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1:A" & i) = Application.Transpose(tablo())

Remplace cette ligne par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Range("A1:A" & i) = Application.WorksheetFunction.Transpose(tablo())

Tu dis
A+

**CRACOS38** · 09/07/2009, 12h01

Bonjour, bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'A tout hasard, je me suis rappelé de ça :
   cells(1,1)= "1,234,567.89"'(par exemple)
     Application.DecimalSeparator = "-"'(toujours par exemple)
    Application.ThousandsSeparator = "*-"'(et encore)
    Application.UseSystemSeparators = False

**Fvandermeulen** · 09/07/2009, 14h36

Re,

Bien que le post soit résolu car mon code est OK (2' au lieu 20'), petit retour sur les dernières propositions:

Envoyé par ouskel'n'or

Remplace cette ligne par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        Range("A1:A" & i) = Application.WorksheetFunction.Transpose(tablo())

Tu dis
A+

J'ai testé pour pouvoir te réponde et désolé, j'ai toujours le message d'erreur type13

Envoyé par CRACOS38
Bonjour, bonjour,

Code :
'A tout hasard, je me suis rappelé de ça :
cells(1,1)= "1,234,567.89"'(par exemple)
Application.DecimalSeparator = "-"'(toujours par exemple)
Application.ThousandsSeparator = "*-"'(et encore)
Application.UseSystemSeparators = False

Merco, mais toujours le même problème avec le code de mon post initial, je ne sais pas quand faire ce genre d'action...mùais je crois que ça peut me servir pour autre chose.

Encore merci, comme je l'ai dit le code final est OK

A+

Import fichier txt plus de points [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager