Question

我每天早上运行这段代码来更新FanGraphs的统计信息。直到大约1个月前，此代码在我的家用PC和工作PC上均起作用。但是现在，“。WebTables =“行在两台PC之间的工作方式有所不同。在我的工作簿中的其他多个地方，此代码用于不同的URL和表。此“ .WebTables =”代码行也是相同的问题。

在家用PC上，我使用.WebTables = "21"。数据被导入到A：S列，而B列为空白（我不知道为什么，这就是它的导入方式）。在我的工作PC上，此行必须为.WebTables = "12"。
在.WebTables = "12"版本中，导入的列为A：R，而列B不为空。这种差异弄乱了我在图纸上的计算。

为什么在两台PC之间如何导入该文件？最后，我检查了两者是否都使用了VBA版本7.1和相同的引用。除非我的PC上有其他规格，否则我需要检查或引用我是否需要在VBA中检查或更新？

Sub RP_stats()

    Sheet46.Select
    Dim URL As String
    URL = "URL;https://www.fangraphs.com/leaders.aspx?pos=all&stats=rel&lg=all&qual=1&type=c,11,114,13,120,121,217,113,43,44,48,51,42,6,122,223&season=2019&month=0&season1=2019&ind=0&team=0&rost=0&age=0&filter=&players=0&sort=8,d&page=1_400"
    'url = custom leader board for season long RP pitching stats

    On Error Resume Next
    ActiveSheet.ShowAllData
    Range("a:s").ClearContents
    On Error GoTo 0

    With Sheet46.QueryTables.Add(Connection:= _
        URL, Destination:=Range("a2"))
        '.Name = "RPstats"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "21"           'the table number to get the right table of data. THIS TABLE DIFFERS BETWEEN PCs FOR SOME REASON
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Answer 1

您可以切换到使用xmlhttp，然后使用表的ID定位它

Option Explicit

Public Sub GetTable()
    Dim html As HTMLDocument, hTable As HTMLTable  '<  VBE > Tools > References > Microsoft HTML Object Library
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.fangraphs.com/leaders.aspx?pos=all&stats=rel&lg=all&qual=1&type=c,11,114,13,120,121,217,113,43,44,48,51,42,6,122,223&season=2019&month=0&season1=2019&ind=0&team=0&rost=0&age=0&filter=&players=0&sort=8,d&page=1_400", False
        .send
        html.body.innerHTML = .responseText
    End With
    Set hTable = html.querySelector("#LeaderBoard1_dg1_ctl00")
    Writetable hTable, 1, ThisWorkbook.Worksheets("Sheet1")
End Sub

Public Sub Writetable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long, tBody As Object
    r = startRow
    With ActiveSheet
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            If header.className = "rgHeader" Or header.className = "rgHeader rgSorted" Then
                columnCounter = columnCounter + 1
                .Cells(startRow, columnCounter) = header.innerText
            End If
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody               'HTMLTableSection
            Set tRow = tSection.getElementsByTagName("tr") 'HTMLTableRow
            For Each tr In tRow
                If Not (IsError(Application.Match(tr.className, Array("rgRow", "rgAltRow"), 0))) Then
                    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
                End If
            Next tr
        Next tSection
    End With
End Sub

当我在不同的PC上运行此代码时，为什么QueryTable WebTable编号不同？

1 个答案: