AW: hierzu nchgefragt ...
02.11.2019 15:37:54
Christian
Hallo Werner,
wenn du diese Verknüpfung ansprichst, es läuft über diese 3 Makros:
Früher lief es über eine externe Datenverbindung, in der vor Power Query Zeit. Nur als dann Excel 2019 kam und ich damit keine Verbindungen mehr auf der herkömmlichen Weise erstellen konnte, hatte Günther seinerzeit versucht die Daten per PQ abzurufen.
Da dies aber wohl aufgrund der Programmierung bzw. des Aufbaus der Internetseite gescheitert war, haben wir damals die Makrolösung erstellt.
Gruß
Christian
Sub Makro1()
'1. Internetseite laden
Sheets("Tabelle1").Select
Columns("I:I").Select
Selection.Replace What:="Tabelle2!", Replacement:="Tabelle3!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Tabelle2").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Tabelle3").Select
Sheets.Add
ActiveSheet.Name = "Tabelle2"
Sheets("Tabelle3").Select
Dim Internet As Object
Set Internet = CreateObject("InternetExplorer.Application")
Internet.Navigate [a1]
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Visible = True
Internet.execwb 17, 0
Internet.execwb 12, 0
Internet.execwb 18, 0
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Quit
Set Internet = Nothing
Sheets("Tabelle2").Select
Range("a1").Select
Sheets("Tabelle2").Paste
Application.OnTime Now + TimeValue("00:00:25"), "Makro2"
End Sub
Sub Makro2()
'2. Internetseite laden
Sheets("Tabelle2").Select
Range("a6000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(3, 0).Select
Sheets("Tabelle3").Select
Dim Internet As Object
Set Internet = CreateObject("InternetExplorer.Application")
On Error GoTo 0
Internet.Navigate [a2]
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Visible = True
Internet.execwb 17, 0
Internet.execwb 12, 0
Internet.execwb 18, 0
Do While Not Internet.ReadyState = 4
DoEvents
Loop
Internet.Quit
Set Internet = Nothing
Sheets("Tabelle2").Select
Sheets("Tabelle2").Paste
Sheets("Tabelle1").Select
Columns("I:I").Select
Selection.Replace What:="Tabelle3!", Replacement:="Tabelle2!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("a1").Select
End Sub
Sub Makro3()
' Makro3 Makro
Columns("I:I").Select
Selection.Replace What:="Tabelle3!", Replacement:="Tabelle2!", LookAt:= _
xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub