Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Modifica Macro Importa Colonna Vincente S.Enalotto

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

Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Francesco6918 » 30/08/20 17:52

Buona sera a tutti gli amici del forum il mio problema è modificare una macro per importare la colonna vincente della prima riga da una tabella dal sito (LOTTOLOGIA), fino a qualche mese fa funzionava tutto poi il sito è stato aggiornato con delle modifiche grafiche,la colonna vincente veniva importata nel intervallo S9:Y9 compreso il numero jolly il sito inserito nella macro era il seguente : "https://www.lottologia.com/superenalotto/?do=archivio-estrazioni&tab=&date=08-11-2019&year=2019&group_num_selector=selected&numbers_selector_mode=add&numbers_selected=#main" ora è diventato : "https://www.lottologia.com/superenalotto/?do=past-draws-archive&table_view_type=simple&year=2020&numbers=" dunque non riesco a moficare la macro via llego il file con la macro inserita.

Grazie

Saluti

http://www.filedropper.com/importacolonnavincente
Francesco6918
Utente Senior
 
Post: 208
Iscritto il: 04/03/11 11:20

Sponsor
 

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Anthony47 » 30/08/20 20:07

Senza stravolgere l'impostazione della tua macro:
Codice: Seleziona tutto
Sub Importa_Colonna_Vincente_Singola_2()
Dim html_Content As Object
Dim Web_Url As String
Dim DataDest As String
Dim myDR As Object
Dim myStr As String, I As Long
'
DataDest = "S10"                '<<< La cella a partire da cui si scrivono i risultati
'
'    Application.ScreenUpdating = False
Range(DataDest).Resize(1, 8).ClearContents          'Azzera l'area dei risultati
Range(Cells(2, 1), Cells(9, 9)).ClearContents
Web_Url = "https://www.lottologia.com/superenalotto/?do=past-draws-archive&table_view_type=simple&year=2020&numbers="
Set html_Content = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
    .Open "GET", Web_Url, False
    .send
    html_Content.Body.Innerhtml = .responseText
End With
Set myDR = html_Content.getElementsByTagName("table")(0).getElementsByTagName("tr")(1)
myStr = Replace(myDR.getElementsByTagName("td")(1).innertext, Chr(13), "", , , vbTextCompare)
For I = 1 To Len(myStr) / 2
    Range(DataDest).Offset(0, I - 1).Value = Mid(myStr, (I - 1) * 2 + 1, 2)
Next I
Range(DataDest).Offset(0, 6).Value = myDR.getElementsByTagName("td")(2).innertext   'Jolly
Range(DataDest).Offset(0, 7).Value = myDR.getElementsByTagName("td")(3).innertext   'Superstar
Set html_Content = Nothing
MsgBox "Importazione Colonna Vincente Singola", vbInformation
Columns("S:Y").ColumnWidth = 5
    Cells(2, 1).Select
End Sub

Prova e fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17155
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Francesco6918 » 31/08/20 00:27

Ciao Anthony47 la macro funziona benissimo eventualmente e possibile importare tuta la tabella tutte le righe, via allego il file con la macro che funzionava prima delle modifiche al sito in cui importavo tutto l archivio 2019. con questo codice nella macro importava tutte le righe del archivio 2019
If iRow = 166 Then GoTo Hop ' decidi quante righe della tabella importare

GRAZIE

Saluti

http://www.filedropper.com/importazione ... alotto2019
Francesco6918
Utente Senior
 
Post: 208
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Anthony47 » 31/08/20 22:51

Se vuoi poter importare piu' estrazioni allora prova questa variante:
Codice: Seleziona tutto
Sub Importa_Colonna_Vincente()
Dim html_Content As Object
Dim Web_Url As String
Dim DataDest As String
Dim myDR As Object, myAllTR As Object
Dim myStr As String, I As Long, J As Long, Limit As Long
'
DataDest = "S10"                '<<< La cella a partire da cui si scrivono i risultati
Limit = 0                       '<<< Il numero di estrazioni da importare; se 0="tutte"
'
Range(Cells(2, 1), Cells(9, 9)).ClearContents
Web_Url = "https://www.lottologia.com/superenalotto/?do=past-draws-archive&table_view_type=simple&year=2020&numbers="
Set html_Content = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
    .Open "GET", Web_Url, False
    .send
    html_Content.Body.Innerhtml = .responseText
End With
Set myAllTR = html_Content.getElementsByTagName("table")(0).getElementsByTagName("tr")
If Limit = 0 Then Limit = myAllTR.Length Else Limit = Limit + 1
If Limit > myAllTR.Length Then Limit = myAllTR.Length
Range(DataDest).Resize(Limit + 2, 8).ClearContents        'Azzera l'area dei risultati
Application.ScreenUpdating = False
'Ciclo per importare:
For J = 1 To Limit - 1
    Set myDR = myAllTR(J)
    myStr = Replace(myDR.getElementsByTagName("td")(1).innertext, Chr(13), "", , , vbTextCompare)
    For I = 1 To Len(myStr) / 2
        Range(DataDest).Offset(J - 1, I - 1).Value = Mid(myStr, (I - 1) * 2 + 1, 2)
    Next I
    Range(DataDest).Offset(J - 1, 6).Value = myDR.getElementsByTagName("td")(2).innertext 'Jolly
    Range(DataDest).Offset(J - 1, 7).Value = myDR.getElementsByTagName("td")(3).innertext 'Superstar
Next J
Set html_Content = Nothing
Application.ScreenUpdating = True
MsgBox "Completata Importazione Colonna Vincente; estrazioni: " & J - 1, vbInformation
Columns("S:Y").ColumnWidth = 5
    Cells(2, 1).Select
End Sub

Le variabili marcate <<< sono da personalizzare come da commenti
In particolare nella variabile Limit puoi inserire quante righe di estrazioni vuoi importare, oppure 0 se vuoi importare tutte le righe che sono presenti in tabella sul sito

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17155
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Francesco6918 » 01/09/20 00:36

Ciao Anthony47 perfetto funziona al momento riguardo l importazione delle colonne S.Enalotto è tutto risolto, inseguito vorrei risolvere il problema riguardo l importazione delle colonne vincente del 10 E Lotto sempre sul sito Lottologia in passato usavo la stessa macro del S.Enalotto modificata per il 10 E Lotto ma anche in questa pagina ci sono state modifiche sito : https://www.lottologia.com/10elotto/?do ... 0&numbers=
in precedenza la prima riga conteneva tutti e 20 numeri attualmente la prima riga contiene i primi 10 numeri e sotto i restanti 10 è piu difficile applicando la tua macro funziona ma ho notato una colonna vuota AC9, non so quale modifica dovrei applicare propongo il file ?con la tua macro, sempre se c'è disponibilità


Ti ringrazio

Saluti

https://app.mediafire.com/myfiles
Francesco6918
Utente Senior
 
Post: 208
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Anthony47 » 01/09/20 14:18

Il link che hai pubblicato porta alla home page di mediafire.com, non consente di scaricare nessun file.

Comunque mi pare che la seguente versione di macro consenta di scaricare sia da Superenelotto che 10 e lotto, a seconda del valore che imposti in Web_Url:
Codice: Seleziona tutto
Sub Importa_Colonna_Vincente()
Dim html_Content As Object
Dim Web_Url As String
Dim DataDest As String
Dim myDR As Object, myAllTR As Object
Dim myStr As String, I As Long, J As Long, Limit As Long
'
DataDest = "S10"                '<<< La cella a partire da cui si scrivono i risultati
Limit = 100                       '<<< Il nume di estrazioni da importare; se 0="tutte"
'
Range(Cells(2, 1), Cells(9, 9)).ClearContents
''Web_Url = "https://www.lottologia.com/superenalotto/?do=past-draws-archive&table_view_type=simple&year=2020&numbers="  'Superenalotto
Web_Url = "https://www.lottologia.com/10elotto/?do=past-draws-archive&table_view_type=simple&year=2020&numbers="        '10 e lotto
Set html_Content = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
    .Open "GET", Web_Url, False
    .send
    html_Content.Body.Innerhtml = .responseText
End With
Set myAllTR = html_Content.getElementsByTagName("table")(0).getElementsByTagName("tr")
If Limit = 0 Then Limit = myAllTR.Length Else Limit = Limit + 1
If Limit > myAllTR.Length Then Limit = myAllTR.Length
Range(DataDest).Resize(Limit + 2, 23).ClearContents        'Azzera l'area dei risultati
Application.ScreenUpdating = False
'Ciclo per importare:
For J = 1 To Limit - 1
    Set myDR = myAllTR(J)
    myStr = Replace(myDR.getElementsByTagName("td")(1).innertext, Chr(13), "", , , vbTextCompare)
    myStr = Replace(myStr, Chr(10), "", , , vbTextCompare)
    For I = 1 To Len(myStr) / 2
        Range(DataDest).Offset(J - 1, I - 1).Value = Mid(myStr, (I - 1) * 2 + 1, 2)
    Next I
    Range(DataDest).Offset(J - 1, I - 1).Value = myDR.getElementsByTagName("td")(2).innertext   'Jolly /Gold
    Range(DataDest).Offset(J - 1, I).Value = myDR.getElementsByTagName("td")(3).innertext       'Superstar  /Gold
Next J
Set html_Content = Nothing
Application.ScreenUpdating = True
MsgBox "Importazione Colonna Vincente; estrazioni: " & J - 1, vbInformation
Columns("S:Y").ColumnWidth = 5
    Cells(2, 1).Select
End Sub

Eventualmente potresti impostare un url oppure l'altro a seconda del Foglio in cui ti trovi.

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17155
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Importa Colonna Vincente S.Enalotto

Postdi Francesco6918 » 01/09/20 16:15

Ciao Anthony47 scusa ma ieri sera non riuscivo a caricare il file sul sito filedropper ora ci sono riuscito allego il file comunque la tua macro per il 10 e Lotto funziona salvo problemi tutto funziona alla perfezione .

Saluiti

Grazie

http://www.filedropper.com/importacolon ... te10elotto
Francesco6918
Utente Senior
 
Post: 208
Iscritto il: 04/03/11 11:20


Torna a Applicazioni Office Windows


Topic correlati a "Modifica Macro Importa Colonna Vincente S.Enalotto":

Macro colora
Autore: Statix
Forum: Applicazioni Office Windows
Risposte: 7

Chi c’è in linea

Visitano il forum: Nessuno e 40 ospiti