XL 2016 Convertir fichier HTML en format CSV

[debenexcel]

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,

 

[patricktoulon]

bonjour
et si tu nous donnais plutôt le fichier html à convertir plutôt que le résultat dans un xl

 

[debenexcel]

Bonjour,
Les fichiers originaux comportent des renseignements personnels, mais voici une copie de la structure en format HTML.
Merci

 

[patricktoulon]

re
voila voila

ps: j'ai mis un apostrophe aux numériques ils étaient trop longs, excel les abrèges

Option Explicit

Function ConvertHtmlToCsv(fichier, Optional xcode As Long = 0)
    Dim laChaine$, x&, elem As Object, txtCSV$
    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 = "TD" Or elem.tagname = "TH" Then elem.innerhtml = IIf(IsNumeric(elem.innertext), "'", "") & elem.innertext & ";"
        Next
        txtCSV = .getelementsbytagname("TABLE")(1).innertext
    End With

    If xcode = 0 Then
        fichier = Replace(fichier, ".html", ".csv")
        x = FreeFile: Open fichier For Output As #x: Print #x, txtCSV: Close #x
        ConvertHtmlToCsv = fichier
    ElseIf xcode = 1 Then
        ConvertHtmlToCsv = txtCSV
    End If
End Function

et voici différente maniere de l'exploiter

juste convertir en fichier csv

Sub testenregistrement()
'enregistrement du html en csv au meme endroit meme non ext:"csv"
    MsgBox "fichier enregistré sous " & ConvertHtmlToCsv("C:\Users\polux\DeskTop\htmltocsv.html")
End Sub

conversion et ouverture du csv simultanément

Sub convertopendirect()
'convertion et ouverture directe en un coup
    Workbooks.Open ConvertHtmlToCsv("C:\Users\polux\DeskTop\htmltocsv.html"), local:=True
End Sub

récupération simple du textecsv

Sub TextDuCsv()
    Dim txtcode$
    txtcode = ConvertHtmlToCsv("C:\Users\polux\DeskTop\htmltocsv.html", 1)
    MsgBox txtcode

End Sub

récup du textcsv et convertion tableau

Sub OnTheRange()
'récup code csv  et convertion en tableau
    Dim txtcode$, t, t2, c&, lig&, col
    txtcode = ConvertHtmlToCsv("C:\Users\polux\DeskTop\htmltocsv.html", 1)
    t = Split(txtcode, vbCrLf)
    ReDim t2(UBound(t), 100)
    For lig = 0 To UBound(t): col = Split(t(lig), ";"): For c = 0 To UBound(col): t2(lig, c) = col(c): Next: Next
    With Cells(1, 1).Resize(UBound(t2) + 1, UBound(t2, 2))
        .Value = t2
        .EntireColumn.AutoFit
    End With
End Sub

demo convert ouverture directe

tu a la totale

 

[Staple1600]

Re

•>patricktoulon
Une petit inclination pour le "Too much" peut-être, non ?
Je dis cela, je dis rien
Mais quand je lis ce pseudo: debenexcel
Il est aisé de deviner: débutant en excel

PS: On mettra cela sur le dos du confinement.
Quoique...

 

[patricktoulon]

re
hihihihi
non mes module xl,csv,html,xml sont connus je reçois même de emails
c'est du prés a l'emploi

 

[Staple1600]

Re

Encore une fois, tu lis les messages en diagonales...
Moi je suis resté sur: débutant en Excel
(qui c'est bien connu, connait Split, Ubound CreateObject et tutti quanti)

PS: Et ça flatte ton ego qu'ils soient connus ?
Tu reçois même des courriels? C'est vrai ? O mazette !
Who's care ?

 

[patricktoulon]

Moi je suis resté sur: débutant en Excel

oui c'est pour ça que je fait du prêt a l'emploi

 

[Staple1600]

Re

Sans commentaires explicatifs dans le code
(Ex: les déclarations)
Sans beaucoup d'explications
Vu d'ici le message#4 ressemble fort à un numéro de camelot *
Mais c'est ton droit le plus strict
Faut bien flatter ton égo
(ou recycler ce qui vient de l'autre monde )

(*: 5 proc, un gif une PJ, n'en jetez plus )

PS: Message rédigé simplement avec une pointe d'ironie caustique tout en restant dans un registre amical
Donc inutile de passer en mode vénère

 

[debenexcel]

@patricktoulon
sauf faute de ma part, mais ça ne fonctionne pas du tout ton code. l'output obtenu est différent de l'output souhaitable.
J'aimerais avoir la description dans une colonne et le code dans une autre colonne. l'ID en premier.
Et si la description comporte plusieurs ID, elle sera dupliquée pour chaque ID. comme dans l'exemple "texte texte texte 4"
Voir capture d'écran ci-joint.

 

[Staple1600]

Re

[aparté]
debenexcel
J'avais bon par rapport à ton pseudo?
Cf message#5)

[/aparté]

 

[patricktoulon]

alors c'est une restructuration de la table
je te fait ca demain ,pour le moment c'est film chips et bierre

 

[Staple1600]

Re

•>debenexcel
Moi, aussi, je suis parti farfouiller dans mes archives
J'ai testé l'import de ton fichier *.html avec le code ci-dessous
(issu de mes archives anglophones, mais point de mon cortex )

Sub HTML_2_XL()
Dim oCell As Object, oRow As Object, html$, x&, y&
Const filePath As String = "C:\Users\STAPLE\Documents\2020\htmltocsv.html" ' à modifier
Open filePath For Input As #1
    html = Input(LOF(1), 1)
Close
x = 1: y = 1
With CreateObject("htmlFile")
    .body.innerhtml = html
    For Each oRow In .getelementsbytagname("table")(1).Rows
        For Each oCell In oRow.Cells
            Sheets(1).Cells(x, y).Value = oCell.innertext
            y = y + 1
        Next oCell
        y = 1
        x = x + 1
    Next oRow
End With
'source:122914:(xf)//[M]150924
End Sub

Est-ce que déjà l'import correspond à ce que tu veux voir dans Excel ?
Si oui, il suffit ensuite de tester une macro de sauvegarde en *.CSV
(Ça tombe les archives du forum en regorgent )

 

[debenexcel]

Merci patricktoulon

 

[debenexcel]

@Staple1600
Je l'ai testé mais ça donne le même résultat.
Merci