Question

我有一个VBA例程，它使用QueryTable.Add非常成功地将网页中的表插入到我的工作表中 - 去年。我正试图从（例如）以下页面导入小联盟棒球统计数据：https://www.baseball-reference.com/register/team.cgi?id=5983843c

以下例程在去年运作良好，但今年Baseball-Reference正在使他们的页面略有不同。奇怪的是team_batting表是普通的html代码，team_pitching表是用注释“注释掉”的。它仍然显示在浏览器中 - 看起来有些代码可以从注释中提取team_pitching表并显示它。您可以在加载页面时看到此行为 - team_batting正好向上，并且有一个简短的空白框架，然后填充team_pitching表。 QueryTable命令仍适用于team_batting表，但忽略team_pitching表。

过去几年这种工作非常精彩......有关如何解决这个问题的想法吗？

这是我的代码：

    InsertAt = ActiveCell.Address(False, False)
With ActiveSheet.QueryTables.Add(Connection:="URL;" & PgURL, Destination:=Range(InsertAt))
    .Name = "team"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = """team_batting"""
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    .Delete
End With

Set FirstBlankCell = Range("C" & Rows.count).End(xlUp).Offset(2, 0)
FirstBlankCell.Activate

InsertAt = ActiveCell.Address(False, False)

With ActiveSheet.QueryTables.Add(Connection:="URL;" & PgURL, Destination:=Range(InsertAt))
    .Name = "team"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingAll
    .WebTables = """team_pitching"""
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    .Delete
End With

Answer 1

由于excel版本无法记录查询，因此这是一个录音（漂亮的）

Sub Macro1()

    ActiveWorkbook.Queries.Add Name:="Team Pitching", _
        Formula:="let" & vbCrLf _
               & "    Source = Web.Page(Web.Contents(""https://www.baseball-reference.com/register/team.cgi?id=5983843c""))," & vbCrLf _
               & "    Data3 = Source{3}[Data]," & vbCrLf _
               & "    #""Changed Type"" = Table.TransformColumnTypes(" _
               & "                          Data3,{" _
               & "                                  {""Rk"",   Int64.Type }, {""Name"",  type text  }, " _
               & "                                  {""Age"",  Int64.Type }, {""W"",     Int64.Type }, " _
               & "                                  {""L"",    Int64.Type }, {""W-L%"",  type number}, " _
               & "                                  {""ERA"",  type number}, {""G"",     Int64.Type }, " _
               & "                                  {""GS"",   Int64.Type }, {""GF"",    Int64.Type }, " _
               & "                                  {""CG"",   Int64.Type }, {""SHO"",   Int64.Type }, " _
               & "                                  {""SV"",   Int64.Type }, {""IP"",    type number}, " _
               & "                                  {""H"",    Int64.Type }, {""R"",     Int64.Type }, " _
               & "                                  {""ER"",   Int64.Type }, {""HR"",    Int64.Type }, " _
               & "                                  {""BB"",   Int64.Type }, {""IBB"",   Int64.Type }, " _
               & "                                  {""SO"",   Int64.Type }, {""HBP"",   Int64.Type }, " _
               & "                                  {""BK"",   Int64.Type }, {""WP"",    Int64.Type }, " _
               & "                                  {""BF"",   Int64.Type }, {""WHIP"",  type number}, " _
               & "                                  {""H9"",   type number}, {""HR9"",   type number}, " _
               & "                                  {""BB9"",  type number}, {""SO9"",   type number}, " _
               & "                                  {""SO/W"", type number}, {""Notes"", type text  }  " _
               & "                                })" & vbCrLf _
               & "in" & vbCrLf _
               & "    #""Changed Type"""

    Sheets.Add After:=ActiveSheet           ' put data in new worsheet

    With ActiveSheet.ListObjects.Add( _
            SourceType:=0, _
            Source:="OLEDB;" _
                  & "Provider=Microsoft.Mashup.OleDb.1;" _
                  & "Data Source=$Workbook$;" _
                  & "Location=""Team Pitching""", _
            Destination:=Range("$A$1")).QueryTable

        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Team Pitching]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "Team_Pitching"
        .Refresh BackgroundQuery:=False
    End With

    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

End Sub

VBA QueryTable和注释表

1 个答案: