Das hat erstmal nix mit...
18.12.2016 11:46:35
Case
Hallo Fred, :-)
... API zu tun.
Du kannst entweder über "XMLHTTP" oder den "InternetExplorer" die Daten ziehen.
Beispiele: ;-)
Option Explicit
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Sub Main()
Const strURL = "http://clubelo.com/Koeln"
Dim strTMP() As String
On Error GoTo Fin
Call DeleteUrlCacheEntry(strURL)
With CreateObject("MSXML2.XMLHTTP")
.Open "Get", strURL, False
.send
strTMP = Split(Split(.responseText, "Total")(1), " ")
With ThisWorkbook.Worksheets("Tabelle3")
.Range("E1").Value = strTMP(0)
End With
End With
Fin:
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Hier erhältst Du (Tabellenblattname anpassen) schon mal die ersten Zahlen (131, 52, 46, 33 und 165-127). Den String musst Du natürlich noch "putzen". ;-)
Oder: ;-)
Option Explicit
Private Enum IE_READYSTATE
Uninitialised = 0
Loading = 1
Loaded = 2
Interactive = 3
Complete = 4
End Enum
Public Sub Main_1()
Dim objContent As Object
Dim objIEApp As Object
Dim objIEDoc As Object
Dim varArr As Variant
Dim lngCol As Long
Dim lngTMP As Long
On Error GoTo Fin
Application.ScreenUpdating = False
varArr = Array("Played_4", "Won_4", "Drawn_4", "Lost_4", "Goals_4", _
"Played_All", "Won_All", "Drawn_All", "Lost_All", "Goals_All")
With ThisWorkbook.Worksheets("Tabelle3") 'Name des Tabellenblattes
.Range(.Cells(1, 1), .Cells(1, UBound(varArr) + 1)) = varArr
.Range(.Cells(1, 1), .Cells(1, UBound(varArr) + 1)).Font.Bold = True
Set objIEApp = CreateObject("InternetExplorer.Application")
objIEApp.Visible = False ' True dann IE sichtbar
objIEApp.Navigate "http://clubelo.com/Koeln"
Do Until objIEApp.readyState = IE_READYSTATE.Complete: DoEvents: Loop
Set objIEDoc = objIEApp.document
Set objContent = objIEDoc.getElementsByTagName("TABLE")(4).getElementsByTagName("TD")
For lngTMP = 0 To 18 Step 2
.Cells(2, lngCol + 1).Value = objContent.Item(lngTMP).innertext
lngCol = lngCol + 1
Next lngTMP
.Columns("A:J").AutoFit
End With
Fin:
Application.ScreenUpdating = True
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & " " & Err.Description
If Not objIEApp Is Nothing Then objIEApp.Quit
Set objContent = Nothing
Set objIEDoc = Nothing
Set objIEApp = Nothing
End Sub
Das gibt schon mehr aus.
Jetzt hast Du genug Ansätze - mach was draus.
Servus
Case