Microsoft 365 Conversion d'un fichier TXT mal foutu....

HAL9000

HAL9000

XLDnaute Nouveau
Bonjour. en possession d'un TX atteint d'un lourd handicap (export de NetBackup) toutes les colonnes (dont celles d'entête) sont reparties sur 3 lignes suivies d'une ligne blanche.. J'ai commencé par une importation via "requete", suivie d'une concaténation, d'une conversion en colonnes et d'une suppression des lignes vides... J'avoue avoir été au plus simple... Je vous joins le fichier TXT... Si quelqu'un avait de bonnes idées, et j'en suis persuadé ce serait sympa. En attendant ce que j'ai mis en place fonctionne mais c'est lent.
 
Solution
job75
Bonjour HAL9000,

Pour supprimer les lignes de titres sauf celle des 1ères en-têtes de colonnes ce n'est guère plus difficile, voyez le fichier (2) zippé et la macro :
VB: 
Sub Importer()
Dim t#, liste, x%, texte$, a$(), n&, i&, texte1$, texte2$, s, ub%, j%
t = Timer
liste = Array("FULL", "SUSPENDED", "FROZEN", "IMPORTED") 'liste pour la colonne STATUS, à adapter
x = FreeFile
Open ThisWorkbook.Path & "\medialist.txt" For Input As #x
While Not EOF(x) 'fin du fichier
    Line Input #x, texte
    texte = Application.Trim(texte) 'SUPPRESPACE
    If Replace(texte, "-", "") <> "" And Not texte Like "Server*" Then
        Select Case i Mod 3
            Case 0: texte1 = texte
            Case 1: texte2 = texte
            Case 2...
Trier par date Trier par votes
HAL9000

HAL9000

XLDnaute Nouveau
WTF à dit:
Bonjour le fil.
Si tu dois convertir régulièrement ce fichier, ca vaut le coup de monter une macro ou de passer par PowerQuery en conservant bien le script de la requette
Cliquez pour agrandir...
C'est bien là le problème je débute et je fais comme je peux... Déjà qu'ils ont changé la façon d'importer un fichier TXT (mode requête)... pour l'heure je me débrouille avec les macros, internet... Mais certaines macros comme "supprimer lignes vides" sont très lentes. Merci pour votre aide en tout cas
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Un premier essai par macro.
Modifier la ligne du chemin du fichier :
VB: 
NomFichier = "C:\Users\PC_PAPA\Desktop\medialist.txt"   ' CHEMIN FICHIER A MODIFIER
Et lancer la macro "Tranfert".
Sur mon PC, votre fichier est importé et mis en forme en 6.5s.
La macro est perfectible, ... si elle marche et correspond à votre besoin.
 

Pièces jointes

  • EssaiImport.xlsm
    243.9 KB · Affichages: 11
Vote positif 0 Vote négatif
HAL9000

HAL9000

XLDnaute Nouveau
sylvanu à dit:
Re,
Un premier essai par macro.
Modifier la ligne du chemin du fichier :
VB: 
NomFichier = "C:\Users\PC_PAPA\Desktop\medialist.txt"   ' CHEMIN FICHIER A MODIFIER
Et lancer la macro "Tranfert".
Sur mon PC, votre fichier est importé et mis en forme en 6.5s.
La macro est perfectible, ... si elle marche et correspond à votre besoin.
Cliquez pour agrandir...
Merci beaucoup pour l'aide rapide... mais je vais devoir attendre d'être chez moi pour valider car la sécurité interdit l'ouverte de votre fichier... C'est d'autant plus compliqué que la largeur des colonnes pour un import fixe est à géométrie variable. C'est fait ! Un grand merci sauf mes intulés de colonnes commencent à la ligne 3 jusquà 5 et que la ligne 6 est inutile mais ça je devrais pouvoir le gérer. Le résultat est du genre "ID" en entete A1, "RL" en B1
 
Dernière édition:
Vote positif 0 Vote négatif
HAL9000

HAL9000

XLDnaute Nouveau
sylvanu à dit:
Re,
Donnez un ex de l' attendu. J'ai fait au plus évident sans connaître la structure de votre fichier.
Mais au moins est ce que le temps d'exécution est "supportable" ?
Cliquez pour agrandir...
Je travaille justement à essayer de vous fournir cela. Ce fichier est très mal conçu (merci Veritas et Netbackup) avec cette structure sur 3 lignes. Je fais au mieux et vous l'envoie dès que possible.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonsoir HAL9000, sylvanu, le forum,

En effet le fichier texte est vraiment mal fichu.

J'ai mis beaucoup de temps pour arriver à cette solution :
VB: 
Sub Importer()
Dim t#, liste, x%, texte$, a$(), n&, i&, texte1$, texte2$, s, ub%, j%
t = Timer
liste = Array("FULL", "SUSPENDED", "FROZEN", "IMPORTED") 'liste pour la colonne STATUS, à adapter
x = FreeFile
Open ThisWorkbook.Path & "\medialist.txt" For Input As #x
While Not EOF(x) 'fin du fichier
    Line Input #x, texte
    texte = Application.Trim(texte) 'SUPPRESPACE
    If Replace(texte, "-", "") <> "" Then
        If texte Like "Server*" Then
            texte = Replace(texte, " ", Chr(160))
            ReDim Preserve a(n)
            a(n) = texte
            n = n + 1
            i = 0
        Else
            Select Case i Mod 3
                Case 0: texte1 = texte
                Case 1: texte2 = texte
                Case 2
                    If texte Like "On*" Then texte = Replace(texte, " ", Chr(160))
                    texte = texte1 & " " & texte2 & " " & texte
                    s = Split(texte)
                    ub = UBound(s)
                    If s(ub - 2) = liste(0) And s(ub - 1) = liste(1) Then
                        s(ub - 2) = liste(0) & Chr(160) & liste(1)
                        s(ub - 1) = ""
                    ElseIf Not s(ub) Like "On*" Then
                        If IsError(Application.Match(s(ub - 1), liste, 0)) Then s(ub) = Chr(160) & " " & s(ub)
                    End If
                    For j = 0 To ub
                        If s(j) = "STATUS" Then s(j) = s(j - 1) & Chr(160) & s(j) & Chr(160) & s(j + 1): s(j - 1) = "": s(j + 1) = ""
                        If IsDate(s(j)) Or s(j) = "last" Then s(j) = s(j) & Chr(160) & s(j + 1): s(j + 1) = ""
                    Next j
                    ReDim Preserve a(n)
                    a(n) = Application.Trim(Join(s))
                    n = n + 1
            End Select
            i = i + 1
        End If
    End If
Wend
Close #x
'---transposition et conversion---
ReDim b(n - 1, 12) 'base 0
For i = 0 To UBound(b)
    s = Split(a(i))
    For j = 0 To UBound(s)
        b(i, j) = Replace(s(j), Chr(160), " ")
        If IsDate(b(i, j)) Then b(i, j) = CDate(b(i, j))
Next j, i
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
[A1].Resize(n, 13) = b
[D:E,J:L].Columns.AutoFit 'ajuste les largeurs
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
MsgBox "Importation de " & n & " lignes réalisée en " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub
Téléchargez les fichiers zippés joints dans le même dossier (le bureau).

La macro se lance par le raccourci clavier Ctrl+M.

Chez moi elle s'exécute en 1,6 seconde

A+
 

Pièces jointes

  • Import(1).zip
    351.7 KB · Affichages: 11
Vote positif 0 Vote négatif
HAL9000

HAL9000

XLDnaute Nouveau
job75 à dit:
Bonsoir HAL9000, sylvanu, le forum,

En effet le fichier texte est vraiment mal fichu.

J'ai mis beaucoup de temps pour arriver à cette solution :
VB: 
Sub Importer()
Dim t#, liste, x%, texte$, a$(), n&, i&, texte1$, texte2$, s, ub%, j%
t = Timer
liste = Array("FULL", "SUSPENDED", "FROZEN", "IMPORTED") 'liste pour la colonne STATUS, à adapter
x = FreeFile
Open ThisWorkbook.Path & "\medialist.txt" For Input As #x
While Not EOF(x) 'fin du fichier
    Line Input #x, texte
    texte = Application.Trim(texte) 'SUPPRESPACE
    If Replace(texte, "-", "") <> "" Then
        If texte Like "Server*" Then
            texte = Replace(texte, " ", Chr(160))
            ReDim Preserve a(n)
            a(n) = texte
            n = n + 1
            i = 0
        Else
            Select Case i Mod 3
                Case 0: texte1 = texte
                Case 1: texte2 = texte
                Case 2
                    If texte Like "On*" Then texte = Replace(texte, " ", Chr(160))
                    texte = texte1 & " " & texte2 & " " & texte
                    s = Split(texte)
                    ub = UBound(s)
                    If s(ub - 2) = liste(0) And s(ub - 1) = liste(1) Then
                        s(ub - 2) = liste(0) & Chr(160) & liste(1)
                        s(ub - 1) = ""
                    ElseIf Not s(ub) Like "On*" Then
                        If IsError(Application.Match(s(ub - 1), liste, 0)) Then s(ub) = Chr(160) & " " & s(ub)
                    End If
                    For j = 0 To ub
                        If s(j) = "STATUS" Then s(j) = s(j - 1) & Chr(160) & s(j) & Chr(160) & s(j + 1): s(j - 1) = "": s(j + 1) = ""
                        If IsDate(s(j)) Or s(j) = "last" Then s(j) = s(j) & Chr(160) & s(j + 1): s(j + 1) = ""
                    Next j
                    ReDim Preserve a(n)
                    a(n) = Application.Trim(Join(s))
                    n = n + 1
            End Select
            i = i + 1
        End If
    End If
Wend
Close #x
'---transposition et conversion---
ReDim b(n - 1, 12) 'base 0
For i = 0 To UBound(b)
    s = Split(a(i))
    For j = 0 To UBound(s)
        b(i, j) = Replace(s(j), Chr(160), " ")
        If IsDate(b(i, j)) Then b(i, j) = CDate(b(i, j))
Next j, i
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
[A1].Resize(n, 13) = b
[D:E,J:L].Columns.AutoFit 'ajuste les largeurs
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
MsgBox "Importation de " & n & " lignes réalisée en " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub
Téléchargez les fichiers zippés joints dans le même dossier (le bureau).

La macro se lance par le raccourci clavier Ctrl+M.

Chez moi elle s'exécute en 1,6 seconde

A+
Cliquez pour agrandir...
Il est tard et une fois de plus je remercie tous les membres de leur soutien.. Je testerai demain mais j'apprécie d'être soutenu dans ma dénomination d'un fichier texte mal foutu... faute de quoi je n'aurais pas eu besoin de soumettre ce problème à la communauté. Je viens de tester le VB c'est le nec plus ultra car vous avez su interprêter 3 lignes dont une partie est l'entete des colonnes.

Je garde quelques lignes parasites au changement des serveurs inventoriés (ligne 4634 et 4635) ou l'on retouve cette foutue entête. Le fichier est trop gros pour vous le faire parvenir. je joins donc une copie d'écran. Tout comme la première ligne est inutile et il me faut filtrer sur l'entete des colonnes

En faisant un petit effort, je devrais arriver à retirer ses lignes par une autre macro.

Merci à Job75 pour ce superbe développement
 

Pièces jointes

  • 2021-12-22 12_00_22-Import Medialist - Excel.jpg
    2021-12-22 12_00_22-Import Medialist - Excel.jpg
    62.4 KB · Affichages: 11
Dernière édition:
Vote positif 0 Vote négatif
HAL9000

HAL9000

XLDnaute Nouveau
Etant en vacances jusqu'à début 2022 je ne suis pas en mesure de tester les deux solutions proposées en réel. J'ai déjà travaillé sur celle de Sylvanu et c'est un pas de géant. Je vais m'occuper de celle fournie par Job75 qui a bien appréhendé l'architecture de malade de ce fichier. Je remercie une nouvelle fois véritas. Bonnes fêtes à tous
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour HAL9000,

Pour supprimer les lignes de titres sauf celle des 1ères en-têtes de colonnes ce n'est guère plus difficile, voyez le fichier (2) zippé et la macro :
VB: 
Sub Importer()
Dim t#, liste, x%, texte$, a$(), n&, i&, texte1$, texte2$, s, ub%, j%
t = Timer
liste = Array("FULL", "SUSPENDED", "FROZEN", "IMPORTED") 'liste pour la colonne STATUS, à adapter
x = FreeFile
Open ThisWorkbook.Path & "\medialist.txt" For Input As #x
While Not EOF(x) 'fin du fichier
    Line Input #x, texte
    texte = Application.Trim(texte) 'SUPPRESPACE
    If Replace(texte, "-", "") <> "" And Not texte Like "Server*" Then
        Select Case i Mod 3
            Case 0: texte1 = texte
            Case 1: texte2 = texte
            Case 2
                If texte Like "On*" Then texte = Replace(texte, " ", Chr(160))
                texte = texte1 & " " & texte2 & " " & texte
                s = Split(texte)
                ub = UBound(s)
                If s(ub - 2) = liste(0) And s(ub - 1) = liste(1) Then
                    s(ub - 2) = liste(0) & Chr(160) & liste(1)
                    s(ub - 1) = ""
                ElseIf Not s(ub) Like "On*" Then
                    If IsError(Application.Match(s(ub - 1), liste, 0)) Then s(ub) = Chr(160) & " " & s(ub)
                End If
                For j = 0 To ub
                    If s(j) = "STATUS" Then s(j) = s(j - 1) & Chr(160) & s(j) & Chr(160) & s(j + 1): s(j - 1) = "": s(j + 1) = ""
                    If IsDate(s(j)) Or s(j) = "last" Then s(j) = s(j) & Chr(160) & s(j + 1): s(j + 1) = ""
                Next j
                If Not s(ub) Like "On*" Or n = 0 Then 'évite les lignes de titres sauf celle des 1ères en-têtes de colonnes
                    ReDim Preserve a(n)
                    a(n) = Application.Trim(Join(s))
                    n = n + 1
                End If
        End Select
        i = i + 1
    End If
Wend
Close #x
'---transposition et conversion---
ReDim b(n - 1, 12) 'base 0
For i = 0 To UBound(b)
    s = Split(a(i))
    For j = 0 To UBound(s)
        b(i, j) = Replace(s(j), Chr(160), " ")
        If IsDate(b(i, j)) Then b(i, j) = CDate(b(i, j))
Next j, i
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
[A1].Resize(n, 13) = b
[D:E,J:L].Columns.AutoFit 'ajuste les largeurs
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
MsgBox "Importation de " & n & " lignes réalisée en " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub
J'espère que vous mettrez ce post #14 comme solution à la place de votre post #12 !!!

A+
 

Pièces jointes

  • Import(2).zip
    349.8 KB · Affichages: 9
Vote positif 0 Vote négatif
Solution
HAL9000

HAL9000

XLDnaute Nouveau
job75 à dit:
Bonjour HAL9000,

Pour supprimer les lignes de titres sauf celle des 1ères en-têtes de colonnes ce n'est guère plus difficile, voyez le fichier (2) zippé et la macro :
VB: 
Sub Importer()
Dim t#, liste, x%, texte$, a$(), n&, i&, texte1$, texte2$, s, ub%, j%
t = Timer
liste = Array("FULL", "SUSPENDED", "FROZEN", "IMPORTED") 'liste pour la colonne STATUS, à adapter
x = FreeFile
Open ThisWorkbook.Path & "\medialist.txt" For Input As #x
While Not EOF(x) 'fin du fichier
    Line Input #x, texte
    texte = Application.Trim(texte) 'SUPPRESPACE
    If Replace(texte, "-", "") <> "" And Not texte Like "Server*" Then
        Select Case i Mod 3
            Case 0: texte1 = texte
            Case 1: texte2 = texte
            Case 2
                If texte Like "On*" Then texte = Replace(texte, " ", Chr(160))
                texte = texte1 & " " & texte2 & " " & texte
                s = Split(texte)
                ub = UBound(s)
                If s(ub - 2) = liste(0) And s(ub - 1) = liste(1) Then
                    s(ub - 2) = liste(0) & Chr(160) & liste(1)
                    s(ub - 1) = ""
                ElseIf Not s(ub) Like "On*" Then
                    If IsError(Application.Match(s(ub - 1), liste, 0)) Then s(ub) = Chr(160) & " " & s(ub)
                End If
                For j = 0 To ub
                    If s(j) = "STATUS" Then s(j) = s(j - 1) & Chr(160) & s(j) & Chr(160) & s(j + 1): s(j - 1) = "": s(j + 1) = ""
                    If IsDate(s(j)) Or s(j) = "last" Then s(j) = s(j) & Chr(160) & s(j + 1): s(j + 1) = ""
                Next j
                If Not s(ub) Like "On*" Or n = 0 Then 'évite les lignes de titres sauf celle des 1ères en-têtes de colonnes
                    ReDim Preserve a(n)
                    a(n) = Application.Trim(Join(s))
                    n = n + 1
                End If
        End Select
        i = i + 1
    End If
Wend
Close #x
'---transposition et conversion---
ReDim b(n - 1, 12) 'base 0
For i = 0 To UBound(b)
    s = Split(a(i))
    For j = 0 To UBound(s)
        b(i, j) = Replace(s(j), Chr(160), " ")
        If IsDate(b(i, j)) Then b(i, j) = CDate(b(i, j))
Next j, i
'---restitution---
Application.ScreenUpdating = False
Cells.Delete 'RAZ
[A1].Resize(n, 13) = b
[D:E,J:L].Columns.AutoFit 'ajuste les largeurs
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
MsgBox "Importation de " & n & " lignes réalisée en " & Format(Timer - t, "0.00 \sec"), , "Import"
End Sub
J'espère que vous mettrez ce post #14 comme solution à la place de votre post #12 !!!

A+
Cliquez pour agrandir...
C'est déjà fait : ma base d'inventaire de bandes va pouvoir etre consolidée avec celle reçue de prestataire sous un format cohérent. je vais du recherchev et aux fantaisies pour la suite. J'avoue que je ne me suis encore plongé dans votre mais je n'y manquerai pas.
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
XL 2016 Formatage fichier TXT sans séparateur et longueur ligne variable
Réponses
0
Affichages
2 K
Flx1er
F
R
  • Question
XL 2019 Import Export fichier .txt ou .csv
Réponses
8
Affichages
3 K
RBADA
R
T
  • Question
Transformation données d'un fichier Txt en Excel
Réponses
6
Affichages
1 K
ted1057
T
S
  • Question
Importation fichier txt délimité par "|" en VBA
Réponses
5
Affichages
4 K
Soleil11
S
P
  • Question
importer une partie d'un fichier txt
2
Réponses
18
Affichages
29 K
JNP
JNP
F
  • Question
Copie contenu d'un fichier .txt sur cellule
Réponses
2
Affichages
2 K
flosauveur69
F
R
  • Question
Copier des données d'un fichier TXT vers une feuille Excel
2
Réponses
17
Affichages
12 K
Rio
R
S
  • Question
[Résolu] Récupération de données depuis un fichier .txt ou .pdf
Réponses
3
Affichages
2 K
Sebadoo
S
R
  • Question
lire début fichier ".txt" avant importation?
Réponses
6
Affichages
2 K
mromain
mromain
kalwin
  • Question
Macro transformant les donnees d'un fichier avec demande de devise a rentrer
Réponses
2
Affichages
2 K
kalwin
kalwin

Membres actuellement en ligne

23 membres et 318 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 357
Messages
2 087 570
Membres
103 596
dernier inscrit
matthieu.devillers76