Question

我想知道如何制作一个宏来读取特定网址变量的列表并进行数据查询和另一个名称的新工作表。

例如，在我的网址标签中，我有这个：

Dan     Butler      2017
Dan     Butler      2018
Jack    Riewoldt    2007
Jack    Riewoldt    2008
Jack    Riewoldt    2009
Jack    Riewoldt    2010
Jack    Riewoldt    2011
Jack    Riewoldt    2012
Jack    Riewoldt    2013
Jack    Riewoldt    2014
Jack    Riewoldt    2015
Jack    Riewoldt    2016
Jack    Riewoldt    2017
Jack    Riewoldt    2018

我的网址是：http://www.fanfooty.com.au/players/year.php?firstname=Dylan&surname=Grimes&year=2018

正如您所看到的，唯一的变量是名字和姓氏以及年份。

我想要它，所以宏将为每个新名称创建一个新工作表，并在每年为该工作表添加表。它应该只为它遇到的每个新名称制作一个新表。

我现在拥有的是：

Sub Macro1()
Dim URL As Range
For Each URL In Range("a200:a211").Cells
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.fanfooty.com.au/players/year.phpfirstname=Shaun&surname=Grigg&year=" & URL & "" _
        , Destination:=Range("$a$5"))
        .Name = "Shaun Grigg"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "1"
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    With ActiveSheet
        Range("R:S").EntireColumn.Insert
    End With
Next
End sub

到目前为止，我唯一可以获得的是一张表，让所有表格都可供玩家出现，但我不能同时使用一个宏进行多个玩家。

我获得不同玩家的方式是手动添加工作表并自行调整网址。

谢谢你们

Answer 1

最简单的方法是使用一个单独的程序，一次添加一张纸并用数据填充。然后第二个过程循环遍历数据。

AddConnection添加一个新工作表，其中包含从给定参数加载的数据。

GetAllUrls循环播放数据并调用AddConnection。

如果您的数据不在For，您可能需要根据需要和数据源调整A1:C14循环，但我认为原则很明确。

Option Explicit

Public Sub GetAllUrls()
    Dim wsURL As Worksheet
    Set wsURL = ThisWorkbook.Worksheets("URL") 'here we define the urls worksheet

    Dim i As Long
    For i = 1 To 14 'we assume the data is in A1 to C14 (A=name, B=surname, C=year)
        AddConnection wsURL.Cells(i, 1), wsURL.Cells(i, 2), wsURL.Cells(i, 3)
    Next i
End Sub

Public Sub AddConnection(Name, Surname, Year)
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets.add(After:=ActiveSheet) 'add a new sheet
    ws.Name = Left(Name & " " & Surname & " " & Year, 31) 'rename sheet (sheet names must be max 31 characters)

    With ws.QueryTables.add(Connection:= _
        "URL;http://www.fanfooty.com.au/players/year.php?firstname=" & Name & "&surname=" & Surname & "&year=" & Year _
        , Destination:=Range("$A$1"))
        .Name = Name & " " & Surname & " " & Year
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

如何根据名称向新工作表添加查询？在VBA Excel上

1 个答案: