Import fichier txt plus de points

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 :aie: )

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 :mouarf:

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 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

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

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:

---

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:

---

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

Citation:

---

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.

---

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 ;

Citation:

---

Envoyé par Fvandermeulen

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

---

Auquel cas tu devras préciser

Code:

---

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

---

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

Code:

---

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:

---

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+ :ccool:

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 :oops:

Citation:

---

Envoyé par Fvandermeulen

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

Code:

---

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

---

---

Remplace cette ligne par

Code:

---

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

---

Tu dis
A+

Bonjour, bonjour,

Code:

---

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

---

Re,

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

Citation:

---

Envoyé par ouskel'n'or

Remplace cette ligne par

Code:

---

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

Citation:

---

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+