estrazione/ordinamento dati da pagina web

[nignetto]

ciao Anthony,mi interesserebbe estrarre in excel dei dati presenti in questa pagina
https://betwatch.fr/money
sezione "upcoming"
opzione "match odds"
country/league "all" selezionato..
abbiamo quote e volumi di gioco sei singoli segni...mi interessere se possibile estrarli e averli ordinati come nel file esempio (vedi anche immagine allegata)..da qui poi procederei allo smazzamento delle quote con la routine che mi hai creato tempo fa su q1 qx q2..ma dovrei farlo anche per i volumi di gioco vq vx v2..credi sia fattibile..grazie mille..sempre



https://docs.google.com/spreadsheets/d/ ... ue&sd=true

https://drive.google.com/file/d/1oMvdeb ... sp=sharing

[Anthony47]

Il sito che indichi non presenta i dati come <Table>, ma in formato libero a piecere suo.
L'accesso ai dati e' certamente possibile, ma devo trovare un sistema modulare perche' non ho ne' il tempo ne' la pazienza di prelevarli uno a uno.
Insomma e' possibile che qualcosa possa fare, ma non nel breve...

[nignetto]

Certo.. ovviamente non posso chiederti tanto..ci sono altri siti con gli stessi dati..posso indicarteli x vedere se li sono più facili da prelevare?

[nignetto]

ci sarebbe questo
https://arbworld.net/en/moneyway/footba ... =0&max=300

e questo
http://www.sports-betting-explorer.com/?date=2022-04-28

se ti va di dare un occhiata..grazie mille

[Anthony47]

Queste due hanno delle vere tabelle, quindi dovrebbero essere facilmente catturabili con quanto sta usando l'utente aggittoriu qui: viewtopic.php?f=26&t=112419
Richiede l'installazione dell'ambiente "selenium", vedi viewtopic.php?f=26&t=112225
Ciao

[nignetto]

Ok..ho installato come da procedura e testato con demo.tutto ok..ora come dovrei procedere?

[Anthony47]

In B3 di Foglio1 inserisci l'url del sito, es http://www.sports-betting-explorer.com/?date=2022-04-30
Poi in un modulo standard VUOTO del tuo vba inserisci questo codice:

Codice: Seleziona tutto

Dim WPage As Object          'IN TESTA AL MODULO


Sub myCaller()
Dim myBet As String, myUrl As String
'
Start = Timer
'Crea Driver:
If WPage Is Nothing Then
'    Set WPage = CreateObject("Selenium.EdgeDriver")
    Set WPage = CreateObject("Selenium.CHRomedriver")
End If
'
myUrl = Sheets("Foglio1").Range("B3")
Sheets("Foglio1").Select
Range("A5").Resize(2000, 30).Clear
Call GetAllTablesLE(myUrl, 5, 3)   'Posiziona in riga 5, colonna C
SQuit:
WPage.Quit
Set WPage = Nothing
    Application.Calculation = xlAutomatic
MsgBox "Tempo: " & Format(Timer - Start, "0.00")
End Sub



Sub GetAllTablesLE(myUrl As String, Optional rNum0 As Long = 1, Optional cNum0 As Long = 1)
'Accetta h.links "relativi alla radice
Dim TBColl As Object, StrHtm As String
Dim I As Long, J As Long, myTim As Single
Dim RNum As Long, CNum As Long, HTDoc As Object
Dim iniTab As Long, finiTab As Long
'Dim TArr
Dim TDColl As Object, TRColl As Object, AColl As Object, PiPPo As Long

If WPage Is Nothing Then
     Set WPage = CreateObject("Selenium.CHRomedriver")
End If

'''On Error Resume Next
reUrl:
WPage.Get myUrl
'
WPage.Wait 1000
'Carica e ricarica...
If myUrl <> WPage.Url And PiPPo < 4 Then
    PiPPo = PiPPo + 1
    Debug.Print "Non pronta", PiPPo, myUrl, WPage.Url
    GoTo reUrl
End If
Debug.Print "Pagina pronta", PiPPo, myUrl, WPage.Url
myTim = Timer
'
Set HTDoc = CreateObject("HTMLfile") 'late binding alla html obj lib

'Crea htmlDocument:
HTDoc.Open
lenhtml = Len(WPage.PageSource)
Do
    iniTab = InStr(finiTab + 1, WPage.PageSource, "<table", vbTextCompare)
    finiTab = InStr(iniTab + 1, WPage.PageSource, "</table", vbTextCompare)
    If iniTab = 0 Then Exit Do
    StrHtm = StrHtm & Mid(WPage.PageSource, iniTab, finiTab - iniTab + 10)
Loop
HTDoc.write StrHtm

'Crea root per hLinks
Dim qmPos As Long, hlRoot As String, iHL As String
qmPos = InStr(10, myUrl & "/", "/", vbTextCompare)
hlRoot = Left(myUrl, qmPos - 1)
'
'esamina il tag richiesto:
If Not HTDoc Is Nothing Then
    Set TBColl = HTDoc.getElementsByTagName("table")
    RNum = rNum0: CNum = cNum0
    For I = 0 To TBColl.Length - 1
        RNum = RNum + 1
        Cells(RNum, CNum).Value = "## Table " & I
        Debug.Print "## Table " & I, Format(Timer - myTim, "0.0"), RNum
        Set TRColl = TBColl(I).getElementsByTagName("tr")
        RNum = RNum + 1: CNum = cNum0
        For J = 0 To TRColl.Length - 1
            Set TDColl = TRColl(J).getElementsByTagName("td")
            For k = 0 To TDColl.Length - 1
                Cells(RNum, CNum).Value = TDColl(k).innerText
                Set AColl = TDColl(k).getElementsByTagName("a")
                If AColl.Length > 0 Then
                    iHL = Replace(AColl(0).href, "about:", "", , , vbTextCompare)
                    If Left(iHL, 1) = "/" Then
                        iHL = hlRoot & iHL
                    End If
                    ActiveSheet.Hyperlinks.Add anchor:=Cells(RNum, CNum), _
                           Address:=iHL
                End If
                CNum = CNum + 1
            Next k
            RNum = RNum + 1: CNum = cNum0
    '        Debug.Print "## Table " & I, Format(Timer - myTim, "0.0"), RNum
        Next J
        RNum = RNum + 1
        DoEvents
    Next I
End If
Debug.Print "FINE-LE", RNum, Format(Timer - myTim, "0.00"), myUrl
End Sub


Avvia myCaller, e tutte le tabelle della pagina dovrebbero essere inserite nel foglio da C5
Dovrebbe funzionare con la maggior parte dei siti che espongono i dati in forma di <Table>

Ciao

[nignetto]

Bene Grazie mille..stasera provo

[nignetto]

ok..l importazione funziona..purtroppo i dati che mi interessano sono uniti in una cella..sarebbe possibile con una macro ordinarli come nell esempio alegato nel foglio 2?e poi smazzarli in q1 qx q2 v1 vx v2 come hai fatto per un lavoro precedente se ricordi?
quindi aggiornando..se cambiavano li smazzava facendo scalare il valore precedente verso destra altrimenti non inseriva nulla se uguali...qui il problema è che dovrebbe prendere un riferimento x la ricerca(esempio nome squadra) perche nel precedente lavoro rimaneva la lista incontri fissa invece in questo modo l incontro sparisce perchè gia concluso..che dici?si puo fare?grazie mille
https://docs.google.com/spreadsheets/d/ ... ue&sd=true

[Anthony47]

Beh, vorrei fermarmi a fare il lavoro nuovo, lasciando il vecchio a quanto gia' realizzato (di cui tra l'altro non ricordo granchè)

Per agevolarti nel separare il dato che ti interessa, che ora e' in celle con testo-a-capo (mi apre cge riguardi solo v1, vx e v2) tì lascio la "funzione" Separ, che corrisponde a questo codice:

Codice: Seleziona tutto

Function Separ(ByRef myCell As Range, Optional ByVal Seppp As String = "€", Optional DPoint As String = ".") As Single
Dim mySpl
    mySpl = Split(" " & Seppp & Replace(myCell.Value, DPoint, ",", , , vbTextCompare), Seppp, , vbTextCompare)
    Separ = CSng("0" & Replace(mySpl(UBound(mySpl)), " ", "", , , vbTextCompare))
End Function

Metti il codice in un modulo standard del vba, poi su Excel, ad esempio in J7 di Foglio2 puoi usare la formula

Codice: Seleziona tutto

=Separ(foglio1!K15)

La funzione restituisce l'ultimo valore dopo un separatore indicabile (valore di default pari a "€")
Quindi ti restituira' (coi dati presenti nel tuo foglio demo) il valore 1250 (V1)
Puoi copiare verso destra per avere Vx e V2; poi copia verso il basso per avere V1, Vx e V2 delle altre righe

Ciao

[nignetto]

scusa x il ritardo..funziona..grazie mille