sto utilizzando la seguente macro per aggiornare i risultati su un foglio con nome br serie-a.
vorrei utilizzare sempre questa macro per aggiornare diversi fogli ma con nomi univoci.
chiedo se si può modificare, oppure la cosa non è fattibile.
oppure devo cambiare il nominativo Sheets("br serie-a").Select creando tante macro per ogni foglio.
posto la macro
grazie
- Codice: Seleziona tutto
Sub risultati_1()
'BUONA
Application.ScreenUpdating = False
Dim vCells As Variant
Dim riga_ok() As Boolean, diff As Integer
Dim riga As Long
Dim textinc As String
Dim data_incontro As Date
Application.ScreenUpdating = False
Application.CutCopyMode = False
Set http1 = CreateObject("MSXML2.XMLHTTP")
Sheets("br serie-a").Select
fin = Range("A" & Rows.Count).End(xlUp).Row
If fin < 7 Then Exit Sub
vCells = Range("A1:F" & fin).Value
ReDim riga_ok(fin)
riga = 6
STOP_END = False
Do
If STOP_END Then Exit Do
Do While riga <= fin
riga = riga + 1
If riga > fin Then Exit Do
If Not riga_ok(riga) Then Exit Do
Loop
If riga > fin Then Exit Do
data_incontro = vCells(riga, 1)
anno = Year(data_incontro)
mese = Month(data_incontro)
giorno = Day(data_incontro)
url1 = "https://www.betexplorer.com/results/football/?year=" & Trim(Str(anno)) & "&month=" & Trim(Str(mese)) & "&day=" & Trim(Str(giorno))
http1.Open "POST", url1, False
http1.Send
While http1.READYSTATE <> 4 'Set 2019 - Aggiunta attesa caricamento pagina
DoEvents
If GetAsyncKeyState(VK_END) Or STOP_END Then
Application.StatusBar = "STOP anticipato!"
MsgBox ("STOP ANTICIPATO - Risultati incompleti")
STOP_END = True
Exit Do
End If
Wend
Text = http1.ResponseText
Text = Replace(Text, Chr(34), "")
Text = Replace(Text, "<strong>", "")
Text = Replace(Text, "</strong>", "")
data_sito = DateValue(data_incontro)
For x = riga To fin
DoEvents
If GetAsyncKeyState(VK_END) Or STOP_END Then
Application.StatusBar = "STOP anticipato!"
MsgBox ("STOP ANTICIPATO - Risultati incompleti")
STOP_END = True
Exit For
End If
If riga_ok(x) Then GoTo 100
data_incontro = DateValue(vCells(x, 1))
If data_incontro <> data_sito Then GoTo 100
'sq1 = Replace(LCase(Cells(x, 5)), " ", "-")
sq1 = vCells(x, 5)
sq2 = vCells(x, 6)
riga_ok(x) = True
stringa = ">" & sq1 & " - " & sq2 & "<"
q1 = InStr(1, Text, stringa)
If q1 <> 0 Then
Application.StatusBar = ">>> Aggiornamento Risultato Incontro " & x - 7 & " di " & fin - 7
y = 7: If x > 27 Then y = x - 20
Cells(y, "G").Activate
Application.GoTo ActiveCell, True
q0 = InStr(q1, Text, "</tr>")
q3 = 0
q2 = InStr(q1, Text, "table-main__result")
If q2 > 0 And q2 < q0 Then q3 = InStr(q2, Text, "</td>")
ris1 = -1: ris2 = -1: ris3 = -1: ris4 = -1
If q3 > 0 Then
q5 = InStr(q2, Text, "/>")
q6 = InStr(q2, Text, "</a>")
q4 = InStr(q2, Text, ":")
'stringa = Mid(Text, q2 + 19, q3 - q2 - 19)
'q4 = InStr(1, stringa, ":")
If q4 > 0 And q5 > 0 And q6 > 0 And q5 < q4 And q4 < q6 And q5 < q0 Then
ris1 = Trim(Mid(Text, q5 + 2, q4 - q5 - 2)) 'Left(stringa, q4 - 1))
ris2 = Trim(Mid(Text, q4 + 1, q6 - q4 - 1)) 'stringa, q4 + 1))
End If
q3 = 0
q2 = InStr(q1, Text, "table-main__partial")
If q2 > 0 And q2 < q0 Then q3 = InStr(q2, Text, "("): q4 = InStr(q3, Text, ")")
If q3 > 0 And q4 > 4 And q3 < q0 Then
stringa = Mid(Text, q3 + 1, q4 - q3 - 1)
'(0:0, 2:0)
q3 = InStr(1, stringa, ",")
If q3 > 0 Then
q4 = InStr(1, stringa, ":")
If q4 > 0 Then
ris3 = Trim(Left(stringa, q4 - 1))
ris4 = Trim(Mid(stringa, q4 + 1, q3 - q4 - 1))
End If
End If
End If
End If
If Val(ris1) > -1 And Val(ris2) > -1 Then
'Cells(x, 169) = golsq1 'Scrive i gol su foglio excel
'Cells(x, 170) = golsq2 'Scrive i gol su foglio excel
Cells(x, 15) = Val(ris1)
Cells(x, 16) = Val(ris2)
If Val(ris3) > -1 And Val(ris4) > -1 Then
Cells(x, 17) = Val(ris3)
Cells(x, 18) = Val(ris4)
Cells(x, 19) = Val(ris1) - Val(ris3)
Cells(x, 20) = Val(ris2) - Val(ris4)
End If
End If
End If
100 Next x
'Next nextdays
Loop
Set http1 = Nothing
Application.ScreenUpdating = False
Application.StatusBar = "FINITO SCARICARE RISULTATI"
Cells(1, "a").Activate
Application.GoTo ActiveCell, True
End Sub
