Découpe d'un fichier txt en plusieurs Excel

[steph05]

Bonjour,
J'ai un fichier txt qui contient plus de 300 000 lignes et je veux le découper en plusieurs fichiers Excel.
J'y arrive sauf que le format des nombres n'est pas conservé.

Mes données sont des grands nombres (20 chiffres) donc ils se collent en format scientifique. Comment faire du collage spécial pour coller en foramt texte ?

Ci-joint ma macro:

Dim strFilePath As String, strFilename As String, vFullPath As Variant
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
 
    vFullPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Choisir le fichier à découper")
 
    If vFullPath = False Then Exit Sub
    Application.ScreenUpdating = False
 
    Set oFSObj = CreateObject("Scripting.FileSystemObject")
    strFilePath = oFSObj.GetFile(vFullPath).ParentFolder.Path
    strFilename = oFSObj.GetFile(vFullPath).Name
 
    Set oConn = CreateObject("ADODB.CONNECTION")
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & strFilePath & ";" & _
               "Extended Properties=""text;HDR=No;FMT=Delimited"""
 
    Set oRS = CreateObject("AdoDb.Recordset")
 
    oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
    While Not oRS.EOF
        Sheets.Add
        ActiveSheet.Range("A1").CopyFromRecordset oRS, 65536
    Wend
    oRS.Close
    oConn.Close
    Application.ScreenUpdating = True

Merci pour votre aide

 

[MichelXld]

Re : Découpe d'un fichier txt en plusieurs Excel

bonjour

Tu peux essayer d'indiquer IMEX=1 pour forcer l'importatation au format texte.
(ça fonctionne pour lire dans les classeurs fermés mais je n'ai pas testé dans le fichiers .txt)

"Extended Properties=""text;HDR=No;FMT=Delimited;IMEX=1"""

Bonne journée
MichelXld

 

[steph05]

Re : Découpe d'un fichier txt en plusieurs Excel

Merci mais ça ne marche pas. Mes nombres restent en scientifique.
Comment puis-je faire ?

 

[Spitnolan08]

Re : Découpe d'un fichier txt en plusieurs Excel

Bonjour steph05, Michel,

Bien loin des propositions éclairées de Michel, j'ai essayé ceci :

Sub test()
Range("A1") = Format(CStr(Range("A1")), "@")
End Sub

Mais cela ne permet d'afficher que les 15 premiers chiffres.

Peut être trouveras tu ton bonheur sur le site de Ti.
VeriTi V 3, le site des amis d'Excel et OOo - Acyd (Label Ti) - Acyd (version 1.9)
De mémoire il y traite des grands nombres, mais je ne sais plus où...

Cordialement

 

[steph05]

Re : Découpe d'un fichier txt en plusieurs Excel

Merci, je vais regarder son site parce que mes nombres font 20 caractères.
Sinon, je la mets à quel endroit de mon code ta macro ?

 

[Spitnolan08]

Re : Découpe d'un fichier txt en plusieurs Excel

Re,

Désolé, mais je ne comprends pas : Le code que je t'ai indiqué fonctionnait tout à l'heure mais ça ne marche plus maintenant et je ne sais pas ce que j'ai changé dans ma configuration depuis... Si je trouve je te fais signe.
Décidément depuis hier soir, j'ai un peu de mal...

Cordialement

 

[Spitnolan08]

Re : Découpe d'un fichier txt en plusieurs Excel

Re,

En fait, pour que le code que je t'ai indiqué fonctionne, il faut que tes cellules soient au format texte. Je te propose donc d'ajouter à la suite de ta macro de transfert :

Sub test()
Dim cel As Range, Plage as Range
Cells.NumberFormat = "@"
Set Plage = ActiveSheet.Range("A1").CurrentRegion

    For Each cel In Plage
       If Not IsEmpty(cel) Then cel = Format(CStr(cel), "@")
    Next
End Sub

qui suppose que tes données débutent à la cellule A1 et sont placées dans des cellules contigues. A adapter en fonction de ton cas.

Cordialement

 

[steph05]

Re : Découpe d'un fichier txt en plusieurs Excel

Je me dis que je pourrais modifier le fichier txt pour que la cellule soit reconnue en texte.
Par exemple, je pourrais mettre un "a" à la fin de chaque ligne.

Y a-t-il un moyen pour ajouter un caractère à la fin de chaque ligne d'un fichier txt ?

Merci

 

[Staple1600]

Re : Découpe d'un fichier txt en plusieurs Excel

Bonsoir à tous


Pourrais tu joindre un fichier exemple

(de 100 à 1000 lignes par exemple)

Si les données sont confidentielles

Peux-tu créer un fichier bidon

avec dees nombres de 20 chiffres?

Ainsi on pourra mieux voir ce qu'il en est de l'import dans Excel

 

[Spitnolan08]

Re : Découpe d'un fichier txt en plusieurs Excel

Re,

Je me dis que je pourrais modifier le fichier txt pour que la cellule soit reconnue en texte.
Par exemple, je pourrais mettre un "a" à la fin de chaque ligne.

Avec le code que je t'ai transmis toutes les cellules sont mises au format texte.

Tu n'as pas trouvé ton bonheur sur le site de Ti ?

Cordialement

 

[Spitnolan08]

Re : Découpe d'un fichier txt en plusieurs Excel

Re,

Après recherches, le fichier se trouve sur le site de Ti à
Programmes/LabelTi/Grands Nombres

Cordialement

 

[kiki29]

Re : Découpe d'un fichier txt en plusieurs Excel

En supposant que c'est la colonne A qui contient les identifiants , que l'on veut y ajouter la lettre Z en fin
et que le séparateur est un point virgule

'=====================================================================================
'   VBA Menu    Outils | Références
'               cocher Microsoft Scripting Runtime
'               cocher Microsoft ActiveX Data Objects 2.8 Library
'=====================================================================================

Option Explicit
Dim sCheminFichier As String
Dim sNomFichier As String

Sub ImportGrosFichierTxt()
Dim Fichier As Variant
Dim Conn As ADODB.Connection
Dim Rs As ADODB.RecordSet
Dim FSO As Scripting.FileSystemObject
Dim Debut As Variant
Const NbLignes As Long = 65536

    Fichier = Application.GetOpenFilename("Text Files (*.txt),*.txt")
    If Fichier = False Then Exit Sub

    Application.StatusBar = ""
    Debut = Time
    Application.ScreenUpdating = False

    Set FSO = New Scripting.FileSystemObject
    sCheminFichier = FSO.GetFile(Fichier).ParentFolder.Path
    sNomFichier = FSO.GetFile(Fichier).Name
    Set FSO = Nothing

    Moulinette sCheminFichier & "\" & sNomFichier

    Set Conn = New ADODB.Connection
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & sCheminFichier & ";" & _
              "Extended Properties=""text;" & _
              "HDR=No;" & _
              "FMT=Delimited"""

    Set Rs = New ADODB.RecordSet

    Rs.Open "SELECT * FROM " & sNomFichier, Conn, 3, 1, 1
        While Not Rs.EOF
            Sheets.Add
            ActiveSheet.Range("A1").CopyFromRecordset Rs, NbLignes
        Wend

    Rs.Close
    Conn.Close

    Set Rs = Nothing
    Set Conn = Nothing

    Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00")
    Application.ScreenUpdating = True
End Sub

Private Sub Moulinette(ByVal NomFichier As String)
Dim Chaine As String
Dim NomFichierLu As String, NomFichierCorrige As String
Dim Ar() As String
Const sSep As String * 1 = ";"

    Close
    NomFichierLu = NomFichier
    NomFichierCorrige = sCheminFichier & "\" & "EssaiCor.txt"

    Open NomFichierLu For Input As #1
        Open NomFichierCorrige For Output As #2
            Do
                Line Input #1, Chaine
                Ar = Split(Chaine, sSep)
                Ar(0) = Ar(0) & "Z"
                Print #2, Join(Ar, sSep)
            Loop Until EOF(1)
        Close #2
    Close #1

    Kill NomFichierLu
    Name NomFichierCorrige As NomFichier
End Sub