Блог

Мне удалось создать скрипт vba, который получает данные из таблицы веб-сайта. Все работает именно так, как я хочу, чтобы это работало. Но мне нужно несколько таблиц, и каждый раз имя веб-сайта или таблицы должно отличаться.

Как вы можете видеть ниже в скрипте, я сначала получаю таблицу 10 с веб-сайта, помещаю ее в ячейку B2 и называю ее LT BE1 Home Во втором подразделе, который я вызываю из таблицы 11 с веб-сайта, помещаю ее в ячейку B22 (это на одну ячейку ниже предыдущей таблицы) и называю ее LT BE1 Home.БЫТЬ на расстоянии 1. В обоих случаях URL-адрес остается неизменным

Теперь я хочу повторить этот процесс для 10 других URL-адресов. Таким образом, URL-адрес, адрес назначения и имя таблицы должны меняться каждый раз.

Как мне это сделать? Должен ли я создавать 20 (2 таблицы из 10 разных URL-адресов) или есть другой, более автоматизированный способ сделать это?

 Public Sub ImportTBLHome()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Home"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B2")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" amp; URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "10"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

Public Sub ImportTBLAway()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Away"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B22")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" amp; URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "11"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub