Condividi:        

utilizzare macro per più fogli

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

utilizzare macro per più fogli

Postdi rombotuono » 20/10/23 13:24

Buongiorno,
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
rombotuono
Utente Senior
 
Post: 112
Iscritto il: 09/11/18 17:27

Sponsor
 

Re: utilizzare macro per più fogli

Postdi Anthony47 » 20/10/23 14:17

Mi pare che, dopo aver selezionato il foglio "br serie-a" la macro lavori sempre sul "foglio attivo".
Se ogni foglio contiene i parametri per la query XMLHTTP allora:
-elimina dalla Sub risultati_1 l'istruzione Sheets("br serie-a").Select
-creati una sub aggiuntiva che seleziona uno per uno i fogli che ti interessano e poi chiama la nuova Sub risultati_1; tipo:
Codice: Seleziona tutto
Sub Overall()
Sheets("Foglio1").Select
Call risultati_1
Sheets("Foglio2").Select
Call risultati_1
'etc
End Sub


E' un sistema non efficientissimo ma abbastanza semplice
Avatar utente
Anthony47
Moderatore
 
Post: 19207
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: utilizzare macro per più fogli

Postdi rombotuono » 20/10/23 15:03

Grazie
Anthony47
questa soluzione funziona benenissimo
il problema che ho un centinaio di fogli quindi con l'inserimento di tutti i nomi.la macro risulta molto lunga.
se ci fosse un metodo più corto.
ciao
grazie
rombotuono
Utente Senior
 
Post: 112
Iscritto il: 09/11/18 17:27

Re: utilizzare macro per più fogli

Postdi Anthony47 » 20/10/23 15:23

Se devi farlo con TUTTI i fogli:
Codice: Seleziona tutto
Sub OverTutti()
Dim I As Long
'
For I = 1 To Sheets.Count
    Sheets(I).Select
    Call risultati_1
Next I
End Sub
Avatar utente
Anthony47
Moderatore
 
Post: 19207
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: utilizzare macro per più fogli

Postdi rombotuono » 20/10/23 22:58

grazie
Anthony47
la macro si blocca perchè va a leggere alcuni fogli che non rientrano.
questi fogli bisognerebbe escluderli.
in totale sono sei fogli con nomi univoci.
rombotuono
Utente Senior
 
Post: 112
Iscritto il: 09/11/18 17:27

Re: utilizzare macro per più fogli

Postdi Anthony47 » 21/10/23 10:38

Probabilmente potresti guardare le condizioni che i fogli devono soddisfare perche’ si proceda con la query XMLHTTP; oppure ti crei una lista di Fogli da ignorare.
Tipo:
Codice: Seleziona tutto
Sub QuasiTutti()
Dim I As Long, Ignora
'
Ignora = Array("Foglio33", "CippaCippa")    '<<< Elenco fogli da ignorare

For I = 1 To Sheets.Count
    If IsError(Application.Match(Sheets(I).Name, Ignora, falso)) Then
        Sheets(I).Select
        Call risultati_1
    End If
Next I
End Sub
Avatar utente
Anthony47
Moderatore
 
Post: 19207
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: utilizzare macro per più fogli

Postdi rombotuono » 21/10/23 19:17

grazie
tutto ok
rombotuono
Utente Senior
 
Post: 112
Iscritto il: 09/11/18 17:27


Torna a Applicazioni Office Windows


Topic correlati a "utilizzare macro per più fogli":


Chi c’è in linea

Visitano il forum: Nessuno e 54 ospiti