Du könntest die Daten per PowerQuery in einem Rutsch abrufen.
-
SpielplanTagX ruft die Daten von der Seite für Spieltag X ab (z.B. X = 15 -> Spieltag 15)
-
Spielplan ruft SpielplanTagX mit dem Wert 1-38 auf und fügt die so gewonnen Tabellen zusammen
All das kannst du dir im Detail im PowerQuery-Editor (s. unten) von Excel anschauen.
Beachte das du unten (wenn eingeblendet auch rechts) den Status der Abfrage live verfolgen kannst.
Du kannst die Abfrage unten sogar abbrechen, wenn sie zu lange dauert.
Das Ergebnis schaut so aus:
Das Makro was das bewerkstelligt:
Option Explicit
Sub Spielplan_Importieren()
Dim wkqSpielplanTagX As Excel.WorkbookQuery
Dim wkqSpielplan As Excel.WorkbookQuery
'# PowerQuery's einrichten
With ThisWorkbook.Queries
On Error Resume Next
.Item("Spielplan").Delete
.Item("SpielplanTagX").Delete
On Error GoTo 0
'Funktion hinzufügen: SpielplanTagX
Set wkqSpielplanTagX = _
.Add(Name:="SpielplanTagX", _
Formula:="(TagX as number) as table =>" & vbNewLine & _
"let" & vbNewLine & _
"Source = Web.Page(Web.Contents(""https://www.weltfussball.de/spielplan/3-liga-2016-2017-spieltag/"" & Number.ToText(TagX) & ""/""))," & vbNewLine & _
"Data = Table.RemoveColumns(Source{0}[Data], {""Column4"", ""Column7"", ""Column8""}, MissingField.Ignore)," & vbNewLine & _
"Renamed = Table.RenameColumns(Data, {{""Column1"", ""Datum""}, {""Column2"", ""Zeit""}, {""Column3"", ""Mannschaft1""}, {""Column5"", ""Mannschaft2""}, {""Column6"", ""Ergebnis""}}, MissingField.Ignore)," & vbNewLine & _
"Result = Renamed" & vbNewLine & _
"in" & vbNewLine & _
"Result")
'Abfrage hinzufügen: Spielplan (ruft SpielplanTagX mit Parameter 1-38 auf)
Set wkqSpielplan = _
.Add(Name:="Spielplan", _
Formula:="let" & vbNewLine & _
"TableList = Table.FromValue({1..38})," & vbNewLine & _
"FuncResult = Table.AddColumn(TableList, ""SpielplanTagX"", each SpielplanTagX([Value]))," & vbNewLine & _
"Data = Table.ExpandTableColumn(FuncResult, ""SpielplanTagX"", {""Datum"", ""Zeit"", ""Mannschaft1"", ""Mannschaft2"", ""Ergebnis""}, {""Datum"", ""Zeit"", ""Mannschaft1"", ""Mannschaft2"", ""Ergebnis""})," & vbNewLine & _
"Result = Table.RenameColumns(Data, {""Value"", ""Spieltag""})" & vbNewLine & _
"in" & vbNewLine & _
"Result")
End With
'# Neues Tabellenblatt hinzufügen
' und Spielplan-Daten darauf ablegen
With ThisWorkbook.Worksheets.Add
Dim qt As Excel.QueryTable
Set qt = .ListObjects.Add( _
SourceType:=xlSrcExternal, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & wkqSpielplan.Name, _
Destination:=.Range("A1") _
).QueryTable
With qt
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & wkqSpielplan.Name & "]")
.AdjustColumnWidth = True
.RefreshOnFileOpen = False
.RefreshPeriod = 0
.BackgroundQuery = True '! SQL-Abfrage wird im Hintergrund ausgeführt / blockiert Excel weniger
Call .Refresh
End With
End With
End Sub
Hier findest du den PowerQuery Editor und die Abfagen / Verbindungen:
Grüße
Trägheit
|