如何根据名称在 excel 上创建新选项卡，同时使用查询添加数据？

Question

我想知道我将如何制作一个宏来读取特定 URL 变量的列表并进行数据查询和一个新的 sheet 用于不同的名称。

例如在我的 url 选项卡中我有这个：

        1
Daniel  Butler      2017    1
Daniel  Butler      2018    1
Jack    Riewoldt    2007    2
Jack    Riewoldt    2008    2
Jack    Riewoldt    2009    2
Jack    Riewoldt    2010    2
Jack    Riewoldt    2011    2
Jack    Riewoldt    2012    2
Jack    Riewoldt    2013    2
Jack    Riewoldt    2014    2
Jack    Riewoldt    2015    2
Jack    Riewoldt    2016    2
Jack    Riewoldt    2017    2
Jack    Riewoldt    2018    2

我想要的是能够在 "dan butler" 和 "jack riewoldt" 的选项卡中显示他们每年的统计数据。例如，dan butler 选项卡将包含他 2017 年和 2018 年的统计数据。在我的 url 选项卡中，您可以在旁边看到数字 1 和 2。我期望的是宏会读取带有 1s 和 2s 的列，并且只会在该数字在循环时发生变化时创建一个新选项卡。

我用的url是这个URL我用的是这个：http://www.fanfooty.com.au/players/year.php?firstname=Dylan&surname=Grimes&year=2018

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

我目前拥有的是：

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"))
    .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

Answer 1

请试一试，看看这是否是您想要实现的目标。

Dim ws As Worksheet
Dim destCell As Range

Public Sub GetAllUrls()
Dim wsURL As Worksheet
Dim i As Long
Dim x, dict
Dim shName As String

For Each ws In ThisWorkbook.Sheets
    Application.DisplayAlerts = False
    If Not LCase(ws.Name) Like "url*" Then ws.Delete
Next ws
Set wsURL = ThisWorkbook.Worksheets("URL") 'here we define the urls worksheet
x = wsURL.Range("A1:C14").Value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1) 'we assume the data is in A1 to C14 (A=name, B=surname, C=year)
    shName = x(i, 1) & " " & x(i, 2)
    If Not dict.exists(shName) Then
        dict.Item(shName) = ""
        Set ws = ThisWorkbook.Sheets.Add(after:=ActiveSheet)
        ws.Name = shName
        Set destCell = ws.Range("A1")
        destCell.Interior.Color = vbYellow
    Else
        Set ws = ThisWorkbook.Sheets(shName)
        Set destCell = ws.Cells(ws.UsedRange.Rows.Count + 2, 1)
        destCell.Interior.Color = vbYellow
    End If
    AddConnection ws, x(i, 1), x(i, 2), x(i, 3)
    ws.UsedRange.Columns.AutoFit
Next i

Set dict = Nothing
End Sub

Public Sub AddConnection(ByVal destSheet As Worksheet, Name, Surname, Year)

With ws.QueryTables.Add(Connection:= _
    "URL;http://www.fanfooty.com.au/players/year.php?firstname=" & Name & "&surname=" & Surname & "&year=" & Year _
    , Destination:=destCell)
    .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
destCell.CurrentRegion.Borders.Color = vbBlack
End Sub

如何根据名称在 excel 上创建新选项卡，同时使用查询添加数据？

How to make new tab on excel depending on the name, whilst adding data with queries?

excel

vba

spreadsheet