XL 2019 Import fichier ".txt" avec des caractères cachés qui gênent l'import

[Titof06]

Bonjour à Toutes et Tous,

Je reviens vers vous pour un problème lors d'un import d'un fichier ".txt".

Je vous joins le fichier Excel et ".txt".

Lors de l'import avec la macro, je me trouve avec un problème sur les lignes 10, 14 à 30.

on peut voir qu'il doit y avoir un caractère qui m'empêche de faire une importation propre, comme pour le lignes 1 à 9.

Est-ce que quelqu'un aurait une solution pour moi, svp.

Je vous remercie pour le temps que vous allez passer et vous souhaite une agréable fin de journée,

Titof06

 

[job75]

Ceci dit, si tu tiens absolument à les modifier, je me demande s'il ne faudrait pas simplement supprimer le premier caractère et supprimer le dernier caractère uniquement si c'est un guillemet.
Ça éviterait de supprimer d'éventuels guillemets à l'intérieur de la chaîne de caractères.

Pas de problème, dans ce cas ces guillemets doivent être doublés dans le fichier texte, j'en ai mis sur la 2ème ligne du fichier joint.

La macro modifiée pour pouvoir les conserver :

Sub Ouvrir()
Dim fichier, texte$, a(), n&
fichier = ThisWorkbook.Path & "\Articles_Extraction_Parametrees_POUR TEST.txt"
Open fichier For Input As #1 'ouverture en lecture séquentielle
While Not EOF(1)
    Line Input #1, texte
    texte = Replace(texte, """""", Chr(1)) 'repère les guillemets doubles
    texte = Replace(texte, """", "") 'supprime les guillemets simples
    texte = Replace(texte, Chr(1), """") 'transforme les guillemets doubles en guillemets simples
    ReDim Preserve a(n): a(n) = texte: n = n + 1
Wend
Close #1
Application.ScreenUpdating = False
Cells.ClearContents 'RAZ
With [A1].Resize(n)
    .Value = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
    .TextToColumns .Cells, xlDelimited, TextQualifier:=xlTextQualifierNone, Tab:=True, Other:=False, DecimalSeparator:="." 'commande Convertir
End With
End Sub

 

[Titof06]

Bonsoir,
Sinon, avec Power Query (avec transformation en nombre décimal des colonnes concernées)

let
    Source = Csv.Document(File.Contents("D:\doc\Excel\exemples\PQ\csv\Articles_Extraction_Parametrees_POUR TEST.txt"),[Delimiter="#(tab)", Columns=32, Encoding=1252, QuoteStyle=QuoteStyle.None]),
    #"En-têtes promus" = Table.PromoteHeaders(Source, [PromoteAllScalars=true]),
    #"Type modifié" = Table.TransformColumnTypes(#"En-têtes promus",{{"Remise 1 conv.", type number}, {"Remise 2 conv.", type number}, {"Remise 3 conv.", type number}, {"Remise 4 conv.", type number}, {"Remise 5 conv.", type number}, {"Prix Achat Brut", type number}, {"Prix Public HT", type number}, {"Taux de Marque", type number}})
in
    #"Type modifié"

Bonne soirée

Bonjour cousinhub,

Je vous remercie pour cette solution, mais cela vient compliquer ma macro et ajouter une tâche en plus.

Je vous souhaite une agréable journée,

Titof06

 

[Titof06]

Bonjour,
notes que le séparateur par tabulation est exactement ce qu'attend Excel en copier coller!

Sub test()
    ' Lit le fichier texte et place son contenu dans le presse-papier
    PressePapier = LireFichierTxt(ThisWorkbook.Path & "\Articles_Extraction_Parametrees_POUR TEST.txt")
 
    ' Colle le contenu du presse-papier dans la cellule A1 de la feuille "Source"
    Sheets("Source").Range("A1").PasteSpecial xlPasteAll
 
    ' Vide le presse-papier
    ClearPressePapier
End Sub

Function LireFichierTxt(cheminFichier As String) As String
    Dim numeroFichier As Integer  ' Numéro de fichier unique pour l'opération
    Dim contenu As String         ' Variable pour stocker le contenu du fichier
 
    ' Obtient un numéro de fichier libre
    numeroFichier = FreeFile
 
    ' Ouvre le fichier en mode lecture
    Open cheminFichier For Input As #numeroFichier
 
    ' Lit tout le contenu du fichier en une seule fois (LOF = Length Of File)
    contenu = Input$(LOF(numeroFichier), numeroFichier)
 
    ' Ferme le fichier
    Close #numeroFichier
 
    ' Retourne le contenu lu
    LireFichierTxt = contenu
End Function

Public Function ClearPressePapier()
    ' Efface le contenu texte du presse-papier Windows
    CreateObject("htmlfile").parentwindow.clipboardData.clearData "Text"
End Function

Public Property Let PressePapier(valeur)
    ' Définit le contenu texte du presse-papier Windows
    CreateObject("htmlfile").parentwindow.clipboardData.SetData "Text", valeur
End Property

Public Property Get PressePapier()
    ' Récupère le contenu texte du presse-papier Windows
    PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property

Bonjour dysorthographie,

En utilisant votre code, cela semble ne pas fonctionner.

Je vous remercie pour le temps passé et vous souhaite une agréable journée,

Titof06

 

[Titof06]

Pas de problème, dans ce cas ces guillemets doivent être doublés dans le fichier texte, j'en ai mis sur la 2ème ligne du fichier joint.

La macro modifiée pour pouvoir les conserver :

Sub Ouvrir()
Dim fichier, texte$, a(), n&
fichier = ThisWorkbook.Path & "\Articles_Extraction_Parametrees_POUR TEST.txt"
Open fichier For Input As #1 'ouverture en lecture séquentielle
While Not EOF(1)
    Line Input #1, texte
    texte = Replace(texte, """""", Chr(1)) 'repère les guillemets doubles
    texte = Replace(texte, """", "") 'supprime les guillemets simples
    texte = Replace(texte, Chr(1), """") 'transforme les guillemets doubles en guillemets simples
    ReDim Preserve a(n): a(n) = texte: n = n + 1
Wend
Close #1
Application.ScreenUpdating = False
Cells.ClearContents 'RAZ
With [A1].Resize(n)
    .Value = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
    .TextToColumns .Cells, xlDelimited, TextQualifier:=xlTextQualifierNone, Tab:=True, Other:=False, DecimalSeparator:="." 'commande Convertir
End With
End Sub

Bonjour job75,

Je vous remercie pour ce code qui fonctionne très bien !

Comment puis-je faire si un fichier contient plus de 65536 lignes ?
Devrais-je le scinder en multiples fichier de 65536 lignes ?

Je vous remercie pour le temps que vous m'accordez et vous souhaite une agréable journée,

Titof06

 

[dysorthographie]

Bonjour dysorthographie,

En utilisant votre code, cela semble ne pas fonctionner.

Je vous remercie pour le temps passé et vous souhaite une agréable journée,

Titof06

bonjour,
c'est dommage que tu ne précise pas ce qui ne fonctionne pas .

comment veux-tu que je progresse ? en revanche c'est vrai que tu n'as pas d'obligation de répondre à cette question.

 

[Cousinhub]

Bonjour cousinhub,

Je vous remercie pour cette solution, mais cela vient compliquer ma macro et ajouter une tâche en plus.

Je vous souhaite une agréable journée,

Titof06

Bonjour,
Juste pour info, "compliquer ma macro", avec 1 seule ligne de code VBA....
Et aucune tâche supplémentaire.
Bon courage pour la suite

 

[job75]

Bonjour Titof06, le forum,

Comment puis-je faire si un fichier contient plus de 65536 lignes ?
Devrais-je le scinder en multiples fichier de 65536 lignes ?

Non, il faut transposer le tableau à une dimension :

Sub Ouvrir()
Dim fichier, texte$, a(), n&, b()
fichier = ThisWorkbook.Path & "\Articles_Extraction_Parametrees_POUR TEST.txt"
Open fichier For Input As #1 'ouverture en lecture séquentielle
While Not EOF(1)
    Line Input #1, texte
    texte = Replace(texte, """""", Chr(1)) 'repère les guillemets doubles
    texte = Replace(texte, """", "") 'supprime les guillemets simples
    texte = Replace(texte, Chr(1), """") 'transforme les guillemets doubles en guillemets simples
    ReDim Preserve a(n): a(n) = texte: n = n + 1
Wend
Close #1
'---transposition---
ReDim b(UBound(a), 0) 'tableau à 2 dimensions, base 0
For n = 0 To UBound(a)
    b(n, 0) = a(n)
Next n
'---restitution---
Application.ScreenUpdating = False
Cells.ClearContents 'RAZ
With [A1].Resize(n)
    .Value = b
    .TextToColumns .Cells, xlDelimited, TextQualifier:=xlTextQualifierNone, Tab:=True, Other:=False, DecimalSeparator:="." 'commande Convertir
End With
End Sub

A+

 

[job75]

Pour tester j'ai recopié les lignes 2 à 30 du fichier texte sur 290 000 lignes.

La macro précédente s'exécute chez moi en 11,5 secondes.