Option
Explicit
Sub
Spielplan_Importieren()
Dim
wkqSpielplanTagX
As
Excel.WorkbookQuery
Dim
wkqSpielplan
As
Excel.WorkbookQuery
With
ThisWorkbook.Queries
On
Error
Resume
Next
.Item(
"Spielplan"
).Delete
.Item(
"SpielplanTagX"
).Delete
On
Error
GoTo
0
Set
wkqSpielplanTagX = _
.Add(Name:=
"SpielplanTagX"
, _
Formula:=
"(TagX as number) as table =>"
& vbNewLine & _
"let"
& 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"
)
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
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
Call
.Refresh
End
With
End
With
End
Sub