Valutazione 4.87/ 5 (100.00%) 5838 voti

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
Newbie
 
Post: 5
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
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 14532
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
Newbie
 
Post: 5
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
Newbie
 
Post: 5
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
Newbie
 
Post: 5
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
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 14532
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
Newbie
 
Post: 5
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
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 14532
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
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 14532
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

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Estrarre Dati in Automatico":


Chi c’è in linea

Visitano il forum: Cele79, Marius44 e 20 ospiti