Convert HTML-table to Excel using VBA

后端 未结 9 2254
难免孤独
难免孤独 2021-02-05 02:51

Convert HTML-table to Excel

The code below fetches the HTML-table at https://rasmusrhl.github.io/stuff, and converts it to Excel-format.

The pr

9条回答
  •  眼角桃花
    2021-02-05 03:00

    For a client side solution

    So run this code after the first block of code, it rewrites the final two columns.

    Sub Test2()
        '* tools references ->
        '*   Microsoft HTML Object Library
    
    
        Dim oHtml4 As MSHTML.IHTMLDocument4
        Set oHtml4 = New MSHTML.HTMLDocument
    
        Dim oHtml As MSHTML.HTMLDocument
        Set oHtml = Nothing
    
        '* IHTMLDocument4.createDocumentFromUrl
        '* MSDN - IHTMLDocument4 createDocumentFromUrl method - https://msdn.microsoft.com/en-us/library/aa752523(v=vs.85).aspx
        Set oHtml = oHtml4.createDocumentFromUrl("https://rasmusrhl.github.io/stuff/", "")
        While oHtml.readyState <> "complete"
            DoEvents  '* do not comment this out it is required to break into the code if in infinite loop
        Wend
        Debug.Assert oHtml.readyState = "complete"
    
    
        Dim oTRs As MSHTML.IHTMLDOMChildrenCollection
        Set oTRs = oHtml.querySelectorAll("TR")
        Debug.Assert oTRs.Length = 17
    
        Dim lRowNum As Long
        For lRowNum = 3 To oTRs.Length - 1
    
            Dim oTRLoop As MSHTML.HTMLTableRow
            Set oTRLoop = oTRs.Item(lRowNum)
            If oTRLoop.ChildNodes.Length > 1 Then
    
                Debug.Assert oTRLoop.ChildNodes.Length = 14
    
                Dim oSecondToLastColumn As MSHTML.HTMLTableCell
                Set oSecondToLastColumn = oTRLoop.ChildNodes.Item(12)
    
                ActiveSheet.Cells(lRowNum + 2, 13).Value2 = "'" & oSecondToLastColumn.innerText
    
    
                Dim oLastColumn As MSHTML.HTMLTableCell
                Set oLastColumn = oTRLoop.ChildNodes.Item(13)
    
                ActiveSheet.Cells(lRowNum + 2, 14).Value2 = "'" & oLastColumn.innerText
    
            End If
            'Stop
    
        Next lRowNum
    
        ActiveSheet.Columns("M:M").EntireColumn.AutoFit
        ActiveSheet.Columns("N:N").EntireColumn.AutoFit
    
    
    End Sub
    

    For a Server Side Solution

    Now that we know you control the source script and that it is in R then one can change the R script to style the final columns with mso-number-format:'\@' . Here is a sample R script that achieves this, one builds a CSS matrix of the same dimensions as the data and passes the CSS matrix as a parameter into htmlTable. I have not tampered with your R source instead I give here a simple illustration for you to interpret.

    A=matrix(c("(2)","(4)","(3)","(1)","(5)","(7)"),nrow=2,ncol=3,byrow=TRUE)
    css_matrix <- matrix(data="",nrow=2,ncol=3)
    css_matrix[,3] <- "mso-number-format:\"\\@\""
    htmlTable(x=A,css.cell=css_matrix)
    

    Opening in Excel I get this

    Robin Mackenzie adds

    you might mention in your server-side solution that OP just needs to add css_matrix[,10:11] <- "mso-number-format:\"\@\"" to their existing R code (after the last css_matrix... line) and it will implement your solution for their specific problem

    Thanks Robin

提交回复
热议问题