ho un problema con questo codice scritto dal grande
Anthony47
il problema è il seguente
deve importare da questo link
https://www.betexplorer.com/soccer/aust ... /M3tMxb5f/
la tabella n 4 ma non trovando dei dati la macro si blocca in questo punto
For Each trtr In myItm.Rows
se trova dei dati tutto ok (questa circostanza non si è verificata quando ho testato la macro)
grazie
- Codice: Seleziona tutto
Sub head()
Sheets("Head to head").Select '<<< Il foglio su cui si fara' l'importazione
Range("a:i").ClearContents 'NB: Il fofglio SARA' AZZERATO senza preavviso
' Range("a:i").NumberFormat = "@" 'Colonne in formato Testo
Call head_to_head(Range("y1").Value) ' "Chiama" la GetTabbbSub
Range("a:i").WrapText = False
End Sub
Sub head_to_head(ByVal myURL As String)
Sheets("Head to head").Select
'Va Chiamata passandogli l'URL da leggere
'Variante 2 per betexplorer.com
Dim IE As Object, I As Long
Set IE = CreateObject("InternetExplorer.Application")
'
Debug.Print ">>>", myURL
With IE
.navigate myURL
.Visible = False
'Stop 'Vedi TESTO
End With
Call IEReady(IE, 1)
'
'Cerca i Select 1° e 2° Class=wrap-header__list__item semilong:
Dim myItm As Object, myColl As Object, mmColl As Object, ccColl As Object
For I = 0 To 1
On Error Resume Next
Set myColl = IE.document.getElementsByClassName("wrap-header__list__item semilong")
Set myItm = myColl(I)
Set mmColl = myItm.getElementsByTagName("option")
Set ccColl = myItm.getElementsByTagName("select")
On Error GoTo 0
If myColl.Length = 2 Then
Debug.Print "d", mmColl.Length
ccColl(0).selectedIndex = mmColl.Length - 1
Debug.Print "e", ccColl(0).selectedIndex
ccColl(0).FireEvent "onchange"
Call IEReady(IE, 3)
End If
Next I
'Scrive le tabelle SUL FOGLIO ATTIVO
Set myColl = IE.document.getElementsByTagName("TABLE")
''''For Each myItm In myColl
Set myItm = myColl(3) '0=tab #1; 1 = tab #2, etc
Cells(I + 1, 1) = "Table# " & ti + 1
ti = ti + 1: I = I + 1
For Each trtr In myItm.Rows
For Each tDtD In trtr.Cells
If tDtD.className = "form col_form" Then
Set my2Coll = tDtD.getElementsByTagName("span")
If my2Coll.Length > 0 Then
myout = " "
'Gestion tabella FORM:
For Each pippo In my2Coll
aaaa = pippo.className
If InStr(1, aaaa, "form-s", vbTextCompare) > 0 Then myout = "?-"
If InStr(1, aaaa, "form-l", vbTextCompare) > 0 Then myout = myout & "L-"
If InStr(1, aaaa, "form-w", vbTextCompare) > 0 Then myout = myout & "W-"
If InStr(1, aaaa, "form-d", vbTextCompare) > 0 Then myout = myout & "D-"
Next pippo
myout = Trim(Left(myout, Len(myout) - 1))
Cells(I + 1, J + 1) = myout
J = J + 1
End If
Else
Cells(I + 1, J + 1) = tDtD.innerText
'Legge hyperlink:
If InStr(1, tDtD.innerHTML, "href", vbTextCompare) > 0 Then
DoEvents: DoEvents
On Error Resume Next
ActiveSheet.Hyperlinks.Add anchor:=Cells(I + 1, J + 1), _
Address:=tDtD.getElementsByTagName("a")(0).href
On Error GoTo 0
End If
J = J + 1
End If
Next tDtD
'Allinea al centro se e' una Intestazione:
If trtr.className = "js-tournament" Then
Cells(I + 1, 1).HorizontalAlignment = xlCenter
End If
I = I + 1: J = 0
DoEvents
Next trtr
I = I + 1
'''Next myItm
'
'Call autofil_1
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
