Condividi:        

Estrarre Dati in Automatico

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

Re: Estrarre Dati in Automatico

Postdi bafio60 » 15/08/16 12:22

Ho finalmente trovato una macro che mi torna molto utile, quella postata da Anthony47 , "La "penultima versione" della macro e' questa:", con questa estraggo tutte le partite dal sito http://www.diretta.it ma vorrei, se possibile, che per ogni partita mi estraesse anche il link per analizzare la stessa, tipo questi:
http://www.diretta.it/partita/G6LS4Zh0/ ... ni-partita
http://www.diretta.it/partita/xYau3GDS/ ... ni-partita
è possibile?
Uso Office 2007 su Windows 10 .

Grazie
bafio60
Utente Junior
 
Post: 11
Iscritto il: 09/08/16 18:57

Sponsor
 

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 17/08/16 15:06

Quello che chiedi non e' presente nel codice html come classico tag "<a>", ma e' prodotto da un javascript; da quello che vedo si puo' ricavare elaborando l'Id della tablerow; ma quanto sia affidabile e duratura la soluzione lo puoi immaginare...
Prova aggiungendo queste righe in questa posizione:
Codice: Seleziona tutto
        Next tdtd
        I = I + 1: J = 0
'Inizio Righe Aggiunte:
    myid = trtr.ID
    If Len(myid) > 8 Then
        myHL = "http://www.diretta.it/partita/" & Replace(myid, "g_1_", "", , , vbTextCompare) & "/#informazioni-partita"
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, Columns.Count).End(xlToLeft).Offset(0, 1), _
            Address:=myHL, TextToDisplay:=myHL
    End If
'fine aggiunte
    Next trtr
I = I + 2
Next myItm

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi bafio60 » 18/08/16 13:59

Perfetto, proprio quello che cercavo, ho fatto qualche modifica adattandolo alla mia esigenza ed è ottimo. I link che ne scaturiscono possono essere aperti dalla macro stessa generando ciascuno la sua pagina con i dati rilevati?
Ti invio le semplici modifiche che ho fatto:
Codice: Seleziona tutto
        I = I + 1: J = 0
       
'Inizio Righe Aggiunte:
    myid = trtr.ID
    If Len(myid) > 8 Then
        myHL = "http://www.diretta.it/partita/" & Replace(myid, "g_1_", "", , , vbTextCompare) & "/#statistiche-partite;1"
        If Cells(I, 2) = "Finale" Then
'            ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, Columns.Count).End(xlToLeft).Offset(0, 1), Address:=myHL, TextToDisplay:=myHL
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 7), Address:=myHL, TextToDisplay:=myHL
        End If
    End If
'fine aggiunte

    Next trtr

Credo che tornerò a disturbarti.
Grazie ancora Fabio
bafio60
Utente Junior
 
Post: 11
Iscritto il: 09/08/16 18:57

Re: Estrarre Dati in Automatico

Postdi bafio60 » 18/08/16 14:25

Ho trovato la soluzione registrando una macro aprendo un link, soluzione che tra l'altro ho sempre usato ma questa volta non ci avevo proprio pensato.
Ti ringrazio ancora

Saluti Fabio
bafio60
Utente Junior
 
Post: 11
Iscritto il: 09/08/16 18:57

Re: Estrarre Dati in Automatico

Postdi bafio60 » 18/08/16 17:18

Sono soddisfatto del punto in cui sono arrivaro dato le mie conoscenze di VBA ma adesso non riesco veramente a risolvere, forse sto affogando in un bicchiere di acqua. Qui sotto il link per scaricare il foglio:
https://www.dropbox.com/s/f071k4s2fsmk9j3/Prova.xlsm?dl=0
Non premere il pulsante "aggiorna" ma quello sotto, "esito 1° tempo" , questa macro visita i link che risultano dalla 1° macro e per ogni link apre un nuovo foglio dove mette i dati trovati sul link stesso ma funziona solo per il primo e gli altri fogli rimangono vuoti.
Credo di aver tralasciato un dettaglio piccolo ma significante che io non riesco a trovare.

Grazie per la tua disponibilità
Saluti Fabio
bafio60
Utente Junior
 
Post: 11
Iscritto il: 09/08/16 18:57

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 18/08/16 23:06

Gli altri fogli non rimangono vuoti, semplicemente le scritte cominciano dalla riga con cui aveva terminato sul foglio precedente e quindi non le noti...
Per correggere prova ad aggiungere questa riga in questa posizione:
Codice: Seleziona tutto
        If Cells(riga, 7) <> "" Then
        KK = 0: I = 0                           '<<< AGGIUNGERE
            myURL = (Sheets("Foglio2").Cells(riga, 7))

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi bafio60 » 19/08/16 11:45

Immaginavo che sarebbe stato necessario azzerare delle variabili ma non riuscivo a capire quali, così è perfetto.
Sei un grande, come ho già detto credo di aver nuovamente bisogno di aiuto. Per il momento ti ringrazio tantissimo.
Saluti Fabio
bafio60
Utente Junior
 
Post: 11
Iscritto il: 09/08/16 18:57

Re: Estrarre Dati in Automatico

Postdi giovanni240 » 28/04/17 08:08

buon giorno mi son iscritto ieri sono un semplice appassionato di excel e di statistiche sopratutto sul calcio e nel fare una ricerca su google per una macro che potesse scaricare dei dati da siti come https://www.statistichesulcalcio.com in qui
le web query (per ammissione di Microsoft) non sono idonee come riportato da anthony47 ho trovato questa macro che propone il moderatore anthony47 e da lui modificata lo copiata e lo fatta girare e scarica tutte le tabelle che ci sono sul sito.
Ora mi chiedevo se era possibile modificare questa macro in modo da scaricare solo le tabelle 13--15--17 inoltre si possono scaricare piu campionati o solo un campionato per ogni macro
office 2013
giovanni240
Newbie
 
Post: 2
Iscritto il: 27/04/17 18:24

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 29/04/17 01:48

La Sub GetWebTab2 importa tutte le strutture tabelle presenti nella pagina web indirizzata; avendole TUTTE (che in questi casi e' la cosa piu' difficile) si possono poi prelevare solo quelle di interesse (che e' cosa piu' facile, e soprattutto variabile per ogni utente).

Volendo importare tabelle da altre pagine web va variato l'url con cui la macro lavora.
Ma in questo caso potrebbe allora tornare utile quanto proposto ad altro utente qui: viewtopic.php?f=26&t=106072#p620716
Si tratta di trasformare la Sub GetWebTab2 in una versione parametrizzata che poi va "richiamata" passandogli come parametro l'url di importazione.
Nel tuo caso la versione parametrizzata della Sub GetWebTab2 e' questa:
Codice: Seleziona tutto
Sub GetWebTab2Param(lUrl)
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
''myURL = "http://www.statistichesulcalcio.com/mainstats/italia/Serie-A_71/anno_117.html"     '<<<<
myurl = lUrl
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myurl
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle su foglio5 (su un nuovo foglio)
'Worksheets.Add                                              '<<<<<1  -Nuovo foglio
''Application.Goto (Sheets("Foglio2").Range("A1"))            '<<<<<2  -Foglio esistente
''Cells.Clear
Set myColl = IE.Document.getElementsbyTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
Next myItm
'Legge le tabelle dentro gli iframe:
Set myColl = IE.Document.getElementsbyTagName("iframe")
For F = 0 To myColl.Length - 1
If Left(myColl(F).ID, 7) = "myframe" Then
Set my2coll = myColl(F).contentDocument.getElementsbyTagName("table")
    For Each myItm In my2coll
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
        Set myRColl = myItm.getElementsbyTagName("tr")
        For Each myR In myRColl
            Set myDColl = myR.getElementsbyTagName("td")
            For Each myTD In myDColl
                Cells(I + 1, J + 1) = myTD.innertext
                J = J + 1
            Next myTD
            I = I + 1: J = 0
        Next myR
    I = I + 2
    Next myItm
End If
Next F
'
    Cells.WrapText = False
    Range("A1").Select
'
'Stop     'Vedi testo
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub

Poi va richiamata da un'altra macro in cui predisponi il foglio in cui importare e poi passi alla GetWebTab2Param l'url da cui importare. Del tipo:
Codice: Seleziona tutto
Sub call1()
    Sheets("Foglio1").Select       '<<< Il foglio su cui si fara' l'importazione
    Cells.ClearContents            'NB: Il fofglio SARA' AZZERATO senza preavviso
    Call GetWebTab2Param("http://www.sisal.it/virtual-race/archivio-gare")
    Cells.WrapText = False
'Seconda importazione
    Sheets("Foglio2").Select       '<<< Il foglio su cui si fara' l'importazione
    Cells.ClearContents            'NB: Il fofglio SARA' AZZERATO senza preavviso
    Call GetWebTab2Param("http://www.sisal.it/altroUrl")
    Cells.WrapText = False
'
'altri Blocchi analoghi

End Sub


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi giovanni240 » 29/04/17 06:07

ciao enthony47 ciao a tutti e molte molte grazie per la risposta di enthony47
office 2013
giovanni240
Newbie
 
Post: 2
Iscritto il: 27/04/17 18:24

Re: Estrarre Dati in Automatico

Postdi loris69 » 05/07/17 13:00

Ciao Anthony prima di tutto complimenti x la tua fantastica Macro che risponde a tutte le mie esigenze x risolvere un problema a cui studio da molto tempo. Ti volevo porre un quesito su utilizzo di detta Macro nel caso in cui vorrei esportare tutti risultati di un determinato Campionato dalla prima all'attuale giornata . Mi spiego meglio:
es in questa pagina "http://www.diretta.it/calcio/argentina/primera-b-nacional/risultati/"
la tua macro esporta tutte i risultati dalla Giornata 41 alla Giornata 32 sotto si ferma al link " Mostra piu Incontri".
Ti chiedo se esiste la possibilita di avere tutte le Giornate dalla 41 esima alla 1 ?
Grazie ancora Anthony.
loris69
Newbie
 
Post: 2
Iscritto il: 05/07/17 12:19

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 07/07/17 02:36

Come per tanti altri casi non ti ho abbandonato, ma sono stato in una situazione "migratoria" che mi ha tenuto abbastanza lontano dal pc.

In questo caso bisogna creare una diversa Sub GetWebTab2Param, che al suo interno cerca la fine delle partite disponibili; potrebbe corrispondere al seguente codice:
Codice: Seleziona tutto
Sub GetWebTab2ParamZ1(lUrl)
Dim IE As Object, F As Long
Dim cTdCnt As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myurl = lUrl
Set IE = CreateObject("InternetExplorer.Application")
'
'With IE
    IE.navigate myurl
    IE.Visible = True
reLoop:
    Do While IE.busy: DoEvents: Loop              'Attesa not busy
    Do While IE.readystate <> 4: DoEvents: Loop   'Attesa documento
'End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop
'Specifico della versione Z1 >>>:
Set myTD = IE.document.getElementsByTagName("TD")
If myTD.Length = cTdCnt Then GoTo noLoop
    cTdCnt = myTD.Length
    On Error Resume Next
        IE.document.getElementById("tournament-page-results-more").getElementsByTagName("a")(0).Click
    On Error GoTo 0
    myStart = Timer                                 'attesa javascript
    Do
        DoEvents
        If Timer > myStart + 4 Or Timer < myStart Then Exit Do
    Loop
    GoTo reLoop
'<<< Fine parte specifica
'
noLoop:
'Leggi le tabelle su foglio5 (su un nuovo foglio)
'Worksheets.Add                                              '<<<<<1  -Nuovo foglio
''Application.Goto (Sheets("Foglio2").Range("A1"))            '<<<<<2  -Foglio esistente
''Cells.Clear
Set myColl = IE.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
Next myItm
'Legge le tabelle dentro gli iframe:
Set myColl = IE.document.getElementsByTagName("iframe")
For F = 0 To myColl.Length - 1
If Left(myColl(F).ID, 7) = "myframe" Then
Set my2coll = myColl(F).contentDocument.getElementsByTagName("table")
    For Each myItm In my2coll
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
        Set myRColl = myItm.getElementsByTagName("tr")
        For Each myR In myRColl
            Set myDColl = myR.getElementsByTagName("td")
            For Each myTD In myDColl
                Cells(I + 1, J + 1) = myTD.innertext
                J = J + 1
            Next myTD
            I = I + 1: J = 0
        Next myR
    I = I + 2
    Next myItm
End If
Next F
'
    Cells.WrapText = False
    Range("A1").Select
'
'Stop     'Vedi testo
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub

C'e' un blocco "Specifico della versione Z1", ma anche piccole differenze al resto del codice.
Teoricamente questa versione potrebbe sostituire anche la generica Sub GetWebTab2Param che gia' conosci, ma suggerisco di usare questa versione solo per il caso di cui parliamo, e usare la precedente Sub GetWebTab2Param per tutte le condizioni standard.

Come e' noto l'esecuzione di javascript (che e' quello che c'e' dietro il link "Mostra più incontri") non provoca modifiche agli stati IE.Busy e IE.ReadyStatus,pertanto il completamento e' controllato con un ritardo di 4 secondi; siccome ci sono 5-6 pagine aggiuntive da caricare il tempo di esecuzione facilmente arrivera' sui 25-30 secondi.

Fai sapere, ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi loris69 » 07/07/17 13:42

Se ti avessi conosciuto prima , non sai le ore che avrei risparmiato. Grazie Genius ti verro a rompere al piu' presto. E' una promessa Anthony47 :D :lol:
loris69
Newbie
 
Post: 2
Iscritto il: 05/07/17 12:19

Re: Estrarre Dati in Automatico

Postdi gioninos » 13/12/23 12:07

Non riesco a capire perchè non scarica più le quote

Codice: Seleziona tutto
Sub GetWebTab2()
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myURL = "https://www.betexplorer.com/football/italy/serie-a/results/"     '<<<<
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myURL
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle su foglio5 (su un nuovo foglio)
'Worksheets.Add                                              '<<<<<1  -Nuovo foglio
Application.Goto (Sheets("Foglio1").Range("A1"))            '<<<<<2  -Foglio esistente
Cells.Clear
Set myColl = IE.Document.getElementsbyTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
Next myItm
'Legge le tabelle dentro gli iframe:
Set myColl = IE.Document.getElementsbyTagName("iframe")
For F = 0 To myColl.Length - 1
If Left(myColl(F).ID, 7) = "myframe" Then
Set my2coll = myColl(F).contentDocument.getElementsbyTagName("table")
    For Each myItm In my2coll
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
        Set myRColl = myItm.getElementsbyTagName("tr")
        For Each myR In myRColl
            Set myDColl = myR.getElementsbyTagName("td")
            For Each myTD In myDColl
                Cells(I + 1, J + 1) = myTD.innertext
                J = J + 1
            Next myTD
            I = I + 1: J = 0
        Next myR
    I = I + 2
    Next myItm
End If
Next F
'
    Cells.WrapText = False
    Range("A1").Select
'
'Stop     'Vedi testo
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
gioninos
Utente Junior
 
Post: 16
Iscritto il: 09/05/16 22:23

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 13/12/23 14:12

Questi sviluppi sono sempre a scadenza, anche se la data di scadenza e' ignota; quindi se ha funzionato per 6 e piu' anni e' un miracolo...
Se apri la pagina con InternetExplorer che cosa vedi? Che cosa viene invece importato dalla macro?
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi gioninos » 13/12/23 14:45

dal web mi fa vedere tutto

Immagine

mentre la macro come puoi notare

Immagine

Avevo realizzato anche una versione con queryweb , ma da ieri sera avranno effettuato qualche modifica al sito e non riesco a leggere più le quote
gioninos
Utente Junior
 
Post: 16
Iscritto il: 09/05/16 22:23

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 13/12/23 15:03

dal web mi fa vedere tutto
Usando come browser InternetExplorer?
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi gioninos » 13/12/23 15:09

microsoft edge
gioninos
Utente Junior
 
Post: 16
Iscritto il: 09/05/16 22:23

Re: Estrarre Dati in Automatico

Postdi Anthony47 » 13/12/23 15:39

microsoft edge
Ma quella macro lavora tramite InternetExplorer, che invece oggi (non so da quanto tempo) non visualizza le quotazioni.
Credo di aver gia' sviluppato una equivalente macro che lavora con Chrome o Edge, usando i driver "Selenium". Guarda questa discussione su come preparare il tuo PC: viewtopic.php?f=26&t=112225

Mentre tu ti prepari, io cerco la macro equivalente; e so che quando la pubblichero' la tua piattaforma sara' gia' pronta...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Estrarre Dati in Automatico

Postdi gioninos » 13/12/23 17:14

spero di aver fatto tutto bene
gioninos
Utente Junior
 
Post: 16
Iscritto il: 09/05/16 22:23

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "Estrarre Dati in Automatico":


Chi c’è in linea

Visitano il forum: Nessuno e 90 ospiti