XL 2016 Convertir fichier HTML en format CSV

  • Initiateur de la discussion Initiateur de la discussion debenexcel
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

debenexcel

XLDnaute Nouveau
Bonjour,

Je sollicite votre aide pour une macro Excel. J'ai plusieurs fichiers de données en format HTML que j'aimerais les convertir en format CSV sous Excel avec une macro.
La structure du fichier HTML est la suivante:
Les titres de colonnes commencent à partir de la ligne 19.
Après la table comporte 5 colonnes. Le contenu dans la 1ère colonne est affiché sur deux lignes, j'aimerais copier le texte de la 2e ligne (si existe) dans une nouvelle colonne. Dans certaines lignes de cette première colonne la même description comporte plusieurs codes et numéros. La description est affichée une seule fois, mais le code est le même pour chaque numéro. Pour ces cas, je souhaiterais que la macro dupliquera la description pour chacune des lignes.
Un exemple de ces données est ci-joint vous donnant un aperçu sur l'input et le résultat souhaitable.

Je vous remercie d'avance de votre aide.

Cordialement,
 

Pièces jointes

re
bonjour
oui il y a querytable aussi et tu peux choisir la table que tu veux en l'occurence la 2 ici
VB:
Sub test()
 Columns("B:B").NumberFormat = "@"
  
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;file:///C:/Users/polux/Desktop/htmltocsv.html", Destination:=Range("$A$1"))
        .Name = "htmlto"
        .FieldNames = True
        .PreserveFormatting = True
         .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
          .AdjustColumnWidth = True
         .WebSelectionType = xlSpecifiedTables
        .WebFormatting = True
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
         .Refresh BackgroundQuery:=False
    .Delete
    End With
  Columns("B:B").NumberFormat = "@"
  
End Sub
 
Bonjour patricktoulon

•>patricktoulon
Alors, il se passe bien le confinement par chez toi ? 😉
Je viens de tester ton code.
J'y trouve deux avantages 😉
Comme il faut passer le temps, j'ai juste fait muse muse avec
VB:
Sub test_B()
Dim HTML_file$
HTML_file = "C:\Users\STAPLE\htmltocsv\htmltocsv.html"
With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;file:///" & HTML_file, Destination:=Cells(1))
.Name = "htmlto": .FieldNames = True: .PreserveFormatting = True
.BackgroundQuery = True: .RefreshStyle = 1
.WebSelectionType = xlSpecifiedTables: .WebTables = "2"
.WebPreFormattedTextToColumns = True: .WebConsecutiveDelimitersAsOne = True
.Refresh BackgroundQuery:=False: .Delete
End With
End Sub
Je te laisse réagencer, faut que j'aille au ravitaillement
(j'ai plus de bières!!!)
😉
 
oui j'arrive du dentiste 😉 😀 😀
du coup je vais un peu m'amuser
VB:
Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
        Set trs = .getelementsbytagname("TABLE")(1).getelementsbytagname("tr")
        For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1: tablo(X, g + 1) = Trim(lesgosses(g).innertext): Next
                X = X + 1:
            End If
        Next
        Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
        ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
        Cells(1, 1).Resize(, UBound(ent) + 1) = ent
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\htmltocsv.html"
End Sub
faut bien passer le temps non ?
il vous reste plus qu'a déplacer les colonnes a votre guise
 
Bonjour,
Merci vous deux,
Voici le résultat obtenu en appliquant le dernier code. L'ID ne s'imprime pas en format texte, la date ne s'affiche pas dans le même format, et la description du dernier id n’apparaît pas. Le problème des cases vides est réglé. 🙂 Voir capture
 

Pièces jointes

  • Capture13.PNG
    Capture13.PNG
    14.9 KB · Affichages: 13
re
Dans le fichier original, le dernier descriptif contient 2 ID, j'aimerais l'afficher pour chaque ID dans l'output csv. voir copie de l'original
pour le format, je n'ai rien changé dans le format de ma feuille, c'est le format standard par défaut pour toutes les cellules. devrais-je le mettre en texte?
 

Pièces jointes

  • Capture14.PNG
    Capture14.PNG
    22.3 KB · Affichages: 13
re
bonjour
voila qui te restitue ton tableau correctement
VB:
Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent, a
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
        Set trs = .getelementsbytagname("TABLE")(1).getelementsbytagname("tr")
        For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1
                    If IsDate(Trim(lesgosses(g).innertext)) Then a = CDate(Trim(lesgosses(g).innertext)) Else a = Trim(lesgosses(g).innertext)
                    tablo(X, g + 1) = a: Next
                If tablo(X, 6) = "" Then tablo(X, 6) = tablo(X - 1, 6)
                X = X + 1:
            End If
        Next
        With Range("A:F"):
            .Clear
            .Columns(2).NumberFormat = "@"
            .Range("C:C,E:E").NumberFormat = "m/d/yyyy"
            Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
            ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
            Cells(1, 1).Resize(, UBound(ent) + 1) = ent
            .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        End With
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\htmltocsv.html"
End Sub
 
Bonjour,

Re bonjour l' ami l'agrafe 🙂

PowerQuery étant inclus dans excel 2016 voici pour ceux que ça intéressent une solution dans le zip joint avec le fichier html source et le fichier .xlsx.

Dans la première étape nommée 'Source' de la requête, changez le chemin vers le fichier html source.

Cordialement
 

Pièces jointes

Re Roblochon
Merci! Je ne maîtrise pas PowerQuery mais il semble intéressant et répond au besoin. Mais je comprend pas, j'ai modifié la source des données, puis j'ai modifié mon fichier html en enlevant quelques données pour vérifier son comportement pour les cases vides, mais il n'a pas actualisé l'output. il affiche encore les anciennes données.
Comment régler ça?
 
RE
patricktoulon
Bonjour,
Merci!, ton dernier code fonctionne bien. Mais seulement avec le fichier test. Quand je l'ai appliqué sur mes fichiers originaux, il n'a pas fonctionné du tout. Le fichier original comporte plusieurs tables. Il a pris la première table contenant des titres. Voir un autre exemple plus conforme du fichier HTML (test.html) ainsi que l'output obtenu (capture 15).
Merci de ton aide
 

Pièces jointes

Re Roblochon
J'ai réussi à actualiser la table, mais quand je l'ai appliqué sur un autre fichier, il a affiché un message d'erreur indiquant que Description/Code n'existe pas, pourtant il existe. voir captures.
Comment faire pour régler ce problème?
Merci
 

Pièces jointes

  • Capture17.PNG
    Capture17.PNG
    29.5 KB · Affichages: 13
  • Capture16.PNG
    Capture16.PNG
    36.6 KB · Affichages: 13
re
voila recherche en dom a l'ancienne

fonctionne sur les deux fichiers
VB:
Option Explicit
Function ConvertHtmlToCsv(fichier)
    Dim laChaine$, trs As Object, X&, I&, lesgosses As Object, g&, ent, a, elem
    X = FreeFile: Open fichier For Binary Access Read As #X: laChaine = String(LOF(X), " "): Get #X, , laChaine: Close #X
    With CreateObject("htmlfile")
        .body.innerhtml = laChaine
       
        For Each elem In .all
        If elem.tagname = ("TABLE") And elem.innerhtml Like "*Description/Code*" Then
               Set trs = elem.getelementsbytagname("tr"): Exit For
        End If
        Next
     
       For I = trs.Length - 2 To 0 Step -1
            If trs(I).ChildNodes.Length = 1 Then trs(I + 1).appendchild (trs(I).ChildNodes(0))
        Next
        ReDim tablo(0 To trs.Length - 1, 1 To 6)
        For I = 1 To trs.Length - 1
            If trs(I).ChildNodes.Length > 0 Then
                Set lesgosses = trs(I).ChildNodes
                For g = 0 To lesgosses.Length - 1
                    If IsDate(Trim(lesgosses(g).innertext)) Then a = CDate(Trim(lesgosses(g).innertext)) Else a = Trim(lesgosses(g).innertext)
                    tablo(X, g + 1) = a: Next
                If tablo(X, 6) = "" Then tablo(X, 6) = tablo(X - 1, 6)
                X = X + 1:
            End If
        Next
        With Range("A:F"):
            .Clear
            .Columns(2).NumberFormat = "@"
            .Range("C:C,E:E").NumberFormat = "m/d/yyyy"
            Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
            ent = Array("code", "ID", "Date Acqusition", "Nombre", "Dernière utilisation", "Descriptif")
            Cells(1, 1).Resize(, UBound(ent) + 1) = ent
            .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        End With
    End With
End Function
Sub test()
    ConvertHtmlToCsv "C:\Users\polux\DeskTop\test.html"
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
466
Réponses
7
Affichages
179
  • Question Question
Microsoft 365 CSV en EXCEL
Réponses
1
Affichages
94
Retour