excel - 如何使用变量来表示链接？

Question

我录制了一个宏，并尝试使用 for 循环来调整它，其中包含我想从中刮取数据的不同链接。

问题是，VBA 无法将我的变量识别为链接。当我直接在代码中输入链接时，它可以工作。我不仅需要来自一个链接的数据，还需要来自 500 个链接的数据。

这是我的代码片段:

Dim Link As String
Link = "https://coinmarketcap.com/currencies/bitcoin/historical-data/"
For i = 1 To 5
Link = Cells(i, 1)

     ActiveWorkbook.Queries.Add Name:="Table 0 (3)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Quelle = Web.Page(Web.Contents(""https://coinmarketcap.com/currencies/ontology/historical-data/""))," & Chr(13) & "" & Chr(10) & "    Data0 = Quelle{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Geänderter Typ"" = Table.TransformColumnTypes(Data0,{{""Date"", type date}, {""Open*"", type number}, {""High"", type number}, {""Low"", type number}, {""Close**"", type number}, {""Volume"", type number}, {""Market Cap" & _
        """, type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Geänderter Typ"""
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0 (3)"";Extended Properties=""""" _
        , Destination:=Range("$D$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0 (3)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_0__3"
        .Refresh BackgroundQuery:=False
    End With
Next

一旦我更改变量“link”的链接(“” https://coinmarketcap.comblabla“”)，我就会得到一个应用程序或对象定义的错误。当我深入挖掘并单击数组时，Excel 告诉我导入“链接”未连接到导出。

Answer 1

您可以使用下面的代码获取主要的历史数据表和上面的信息。这有点棘手而且有点脆弱，因为其中很多都依赖于当前的页面样式，而当前页面样式可能会发生变化。作为实际表的历史数据位更健壮。

例如，您可以使用从单元格中挑选的新 URL 进行循环，并且只需使用 Sheets.Add在每个循环开始时插入，这样你就有一个新的 Activesheet 可以写入数据。

下面，应该足以让您根据您的要求开始。

我得到了最重要的一点:



使用
.Cells(1, 1) = IE.document.querySelector(".col-xs-6.col-sm-8.col-md-4.text-left").innerText .这不是很健壮。可以更改文档的样式。但是，它不是页面的一个容易访问的部分，无论您当前选择哪种方法，获取它都可能容易受到攻击。我正在使用元素的类名 ( "." ) 使用 .querySelector 检索信息申请文件的方法CSS selector .col-xs-6.col-sm-8.col-md-4.text-left .与 .getElementsByClassName(0) 相同.

我得到了中间位:



和

Set aNodeList = IE.document.querySelectorAll("[class*='coin-summary'] div")

这使用 CSS 选择器 [class*='coin-summary'] div ，它们是 div元素中的标签，其 className 包含字符串 'coin-summary' .

该 CSS 选择器返回一个列表，因此 .querySelectorAll方法用于返回一个 nodeLIst，然后遍历它。



我使用 table 标签获得了最终的历史数据(这是一个实际的表):

Set hTable = .document.getElementsByTagName("table")(0)

然后我遍历表格的行和行内的单元格。

VBA:

Option Explicit
Public Sub GetInfo()
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "https://coinmarketcap.com/currencies/bitcoin/historical-data/"

        While .Busy Or .readyState < 4: DoEvents: Wend '<== Loop until loaded

        Dim hTable As HTMLTable
        Set hTable = .document.getElementsByTagName("table")(0)

        Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long, hBody As Object
        Dim headers(), headers2()
        headers = Array("Date", "Open*", "High", "Low", "Close**", "volume", "Market Cap")
        headers2 = Array("Market Cap", "Volume (24h)", "Circulating Supply", "Max Supply")

        With ActiveSheet
            .Cells.ClearContents
            .Cells(1, 1) = IE.document.querySelector(".col-xs-6.col-sm-8.col-md-4.text-left").innerText
            Dim aNodeList As Object, i As Long, resumeRow As Long
            Set aNodeList = IE.document.querySelectorAll("[class*='coin-summary'] div")
            resumeRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 2
            .Range("A" & resumeRow).Resize(1, UBound(headers2) + 1) = headers2

            For i = 0 To aNodeList.Length - 1
                .Cells(resumeRow + 1, i + 1) = aNodeList.item(i).innerText
            Next i

            r = .Cells(.Rows.Count, "A").End(xlUp).Row + 2

            .Cells(r, 1).Resize(1, UBound(headers) + 1) = headers
            Set hBody = hTable.getElementsByTagName("tbody")
            For Each tSection In hBody           'HTMLTableSection
                Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
                For Each tr In tRow
                    r = r + 1
                    Set tCell = tr.getElementsByTagName("td")
                    c = 1
                    For Each td In tCell         'DispHTMLElementCollection
                        .Cells(r, c).Value = td.innerText 'HTMLTableCell
                        c = c + 1
                    Next td

                Next tr
            Next tSection


        End With

        'Quit '<== Remember to quit application
        Application.ScreenUpdating = True
    End With
End Sub

工作表中的输出(样本):



来自页面的一些示例数据: