Excel 365-从Web获取带有图像的数据表

时间:2018-09-11 19:08:18

标签: excel vba image web-scraping powerquery

我正在使用Office 365,并且试图从网络上获取数据表,并将其与图像一起导入Excel工作表中。这是我要导入的表:

https://royaleapi.com/clan/90R9VPP9/war/analytics

http://i63.tinypic.com/2s655kx.jpg

从表中可以看到,单元格中的图像代表某些状态,其中包含有意义的数据:

  • 奖章=胜利
  • 交叉=损失
  • 空奖牌位=行动中失踪
  • 空单元格=未参加

我单击数据,然后选择“从Web”,然后在其中粘贴链接。 Excel会显示以下内容,在其中选择表0作为所需的信息。

http://i67.tinypic.com/2lmb4u0.jpg

单击加载后,生成的表如下。如您所见,没有图像表示人的身份,此方法仅获取文本等。但是不应该提取包含图像的单元格。

http://i67.tinypic.com/n3kzz5.jpg

在线搜索之后,我设法将代码隔离到另一个查询(Query1)中,这些查询可以在下面找到。该查询提供图像,但没有将它们放置在单元格中,我只是设法获取图像本身:)

let
Source = Table.FromColumns({Lines.FromBinary(Web.Contents("https://royaleapi.com/clan/8P2V9VYL/war/analytics"), null, null, 65001)}),
#"Filtered Rows" = Table.SelectRows(Source, each Text.Contains([Column1], "src=""/static/img/ui")),
#"Split Column by Delimiter" = Table.SplitColumn(#"Filtered Rows", "Column1", Splitter.SplitTextByEachDelimiter({"src=""/"}, QuoteStyle.None, true), {"Column1.1", "Column1.2"}),
#"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Column1.1", type text}, {"Column1.2", type text}}),
#"Split Column by Delimiter1" = Table.SplitColumn(#"Changed Type", "Column1.2", Splitter.SplitTextByEachDelimiter({""""}, QuoteStyle.None, false), {"Column1.2.1", "Column1.2.2"}),
#"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Column1.2.1", type text}, {"Column1.2.2", type text}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type1",{"Column1.1", "Column1.2.2"}),
#"Added Custom" = Table.AddColumn(#"Removed Columns", "https", each "https://royaleapi.com/"),
#"Reordered Columns" = Table.ReorderColumns(#"Added Custom",{"https", "Column1.2.1"}),
#"Merged Columns" = Table.CombineColumns(#"Reordered Columns",{"https", "Column1.2.1"},Combiner.CombineTextByDelimiter("", QuoteStyle.None),"Merged"),
#"Renamed Columns" = Table.RenameColumns(#"Merged Columns",{{"Merged", "Images"}}),
#"Duplicated Column" = Table.DuplicateColumn(#"Renamed Columns", "Images", "Images - Copy"),
#"Renamed Columns1" = Table.RenameColumns(#"Duplicated Column",{{"Images - Copy", "ImageURLs"}})
in
#"Renamed Columns1"

那么,有什么方法可以在我刷新表格时简单地在正确的单元格中获取正确的图像吗?不幸的是,我的编码知识非常有限,因此我很乐意接受您的建议和帮助:)

提前谢谢! Oandic

1 个答案:

答案 0 :(得分:0)

这显示了如何将图像的链接收集到一个2d数组中,该数组可以在尺寸(行数和列数)匹配时覆盖到工作表中的数据范围。这意味着您可以循环数组的行和列,并使用它们索引到数据范围中以找到正确的位置,然后将图像从图像URL添加到单元格中。

您可以使用.Top.Left进行定位。底部给出了通用大纲代码。您将需要适当调整图像的大小,并同时间隔行和列。

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://royaleapi.com/clan/90R9VPP9/war/analytics", False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    With html
        .body.innerHTML = sResponse
        Dim hTable As HTMLTable
        Set hTable = .getElementsByTagName("table")(0)
    End With
    Dim numRows As Long, numColumns As Long, r As Long, c As Long, tr As Object, td As Object

    numRows = hTable.getElementsByTagName("tr").Length
    numColumns = hTable.getElementsByTagName("tr")(2).getElementsByTagName("td").Length
    Dim arr()
    ReDim arr(1 To numRows, 1 To numColumns)

    For Each tr In hTable.getElementsByTagName("tr")
        r = r + 1: c = 0
        For Each td In tr.getElementsByTagName("td")
            c = c + 1
            arr(r, c) = GetImgLink(td.outerHTML)
        Next
    Next
    [A1].Resize(numRows, numColumns) = arr '<== Just for example to see how would map to sheet
    Stop
End Sub

Public Function GetImgLink(ByVal outerHTML As String) As String
    On Error GoTo Errhand
    GetImgLink = "https://royaleapi.com/" & Split(Split(outerHTML, "IMG class=""ui image"" src=""about:")(1), Chr$(34))(0)
    Exit Function
Errhand:
    Err.Clear
    GetImgLink = vbNullString
End Function

添加图像和定位(假设数据从A1开始,否则对要循环的链接数组的行,列索引进行调整。)

With ActiveSheet.Pictures.Insert(imageURL)  ' <== Change to your sheet
    .Left = ActiveSheet.Cells(1,1).Left '<== row and column argument to cells will come from loop position within array. Adjust if required.
    .Top = ActiveSheet.Cells(1,1).Top
    .Placement = 1
End With

链接如何映射到工作表的示例:

data