if Anweisung für Webabfrage
01.08.2021 17:40:55
Fred
ich möchte die Relevanz von Detail-Infos eines Fußballspiels feststellen. Also Werte aus Live-Spielen wie z.B. Ecken, Schüsse auf das Tor, Schüsse neben das Tor, gefährliche Angriffe, Ballbesitz etc. etc., in Hinsicht auf das spätere Endergebnis. Diese Daten möchte ich Live alle 10 Minuten abrufen und bis ende des Jahres auf einen Datenbestand von über 100.000 kommen.
Nun nutze ich ein Makro von Anton, welches von einer Webseite entsprechende Links zu diesen Detail-Seiten von Fußballspielen feststellt, diese Links mir in Spalte A setzt und in Spalte B eben diese Detail-Infos.
Soweit alles super und ich kann dieses Makro (mit min. Veränderungen) auch auf manch andere Webseiten einsetzen. Allerdings gibt es für oben beschriebene Aufgaben zwei kleine Baustellen, wofür ich unbedingt Hilfe bräuchte. Eine dieser benötigten Hilfen möchte ich in diesen Thread ansprechen.
Das Makro setzt mir alle auf der Seite totalcorner.com/match/today angegebenen Spielinfos in mein Arbeitsblatt. Die Spiele welche bereits begonnen haben (wie gewünscht), allerdings auch die Spiele, welche erst im Laufe des Tages beginnen.
Angenommen; Wochenende --über 300 Spiele im Laufe des Tages Es laufen derzeit 20 Spiele, dessen Infos ich alle 10 Minuten abrufe.
Das würde bedeuten, dass ich in einer Stunde ca. 120 brauchbare Datensätze erhalte und weit über 2.000 Datensätze, die ich wieder lösche. Das ist natürlich in vielerlei Hinsicht Käse.
Ich bräuchte also hier eine Makro-Ergänzung, die nur die Links und Detail-Infos der laufenden Spiele in die Spalten A und B setzt. Alle Spiele mit der Spielzeit >0
Das zu ergänzende Makro:
Sub antonAktuell()
Dim objXMLHTTP As Object, html As Object, html1 As Object
Dim link As Object, div As Object
Dim iRow As Long, start As Single, slink As String
iRow = 1
start = Timer
Set html = CreateObject("htmlfile")
Set html1 = CreateObject("htmlfile")
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.Open "GET", "https://www.totalcorner.com/match/today/", False
objXMLHTTP.send
If objXMLHTTP.Status = 200 Then
html.body.innerHTML = objXMLHTTP.responseText
With ActiveSheet
' .Cells.Clear
For Each link In html.getElementsByTagName("a")
If InStr(1, link.href, "/match/corner-stats") 0 Then
slink = Replace(link.href, "about:", "https://www.totalcorner.com")
.Hyperlinks.Add Anchor:=.Cells(iRow, 1), _
Address:=slink, _
TextToDisplay:=link.nameProp
objXMLHTTP.Open "GET", slink, False
objXMLHTTP.send
If objXMLHTTP.Status = 200 Then
html1.body.innerHTML = objXMLHTTP.responseText
For Each div In html1.getElementsByTagName("div")
If div.classname = "main_content" Then
.Cells(iRow, 2) = div.innerText
End If
Next
End If
iRow = iRow + 1
End If
Next
.Columns.AutoFit
End With
End If
Set objXMLHTTP = Nothing
Set html = Nothing
Set html1 = Nothing
MsgBox (Timer - start) & " sec."
End Sub
td class=text-center match_status
span class="match_status_minutes"
Könnte mal bitte ein Experte draufschauen und mir an richtiger Stelle die passende IF Anweisung schreiben?!
Viele Grüße
Fred