Kikkos73
Junior Member
Grazie!
Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
EXCEL E DINTORNI
- Creatore Discussione claudio8
- Data di inizio
The Wolf
Junior Member
Grazie
The Wolf
Junior Member
buongiorno firefox, grazie del link del foglio excel ma andando ad aggiornare non si riesce considerando che il sito che e' indicato non e' piu' scaricabile il file che deve essere in formato txt o xls?
tu come aggiorni il foglio ?
grazie delle indicazioni
Lottopython
Advanced Member >PLATINUM<
tx dx (archivio)
visualizza codice ,
incolla macro ,
tasto salva in alto a sx
visualizza codice ,
incolla macro ,
tasto salva in alto a sx
Codice:
Sub ImportaFileEstrazioni()
Dim ws As Worksheet
Dim http As Object
Dim contenuto As String
Dim riga As Long, rigaInizio As Long
Dim i As Long, j As Long
Dim linea As String
Dim conteggioImportati As Long
Dim conteggioTrovate As Long
' --- CONFIGURAZIONE ---
Dim ultimaDataArchivio As Date
ultimaDataArchivio = DateSerial(2026, 2, 28)
Dim url As String
url = "https://www.lottologia.com/superenalotto/archivio-estrazioni/?as=TXT&year=2026"
' ----------------------
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set ws = ThisWorkbook.Sheets("Archivio")
rigaInizio = ws.Cells(ws.Rows.Count, "A").End(xlUp).row + 1
' Crea dizionario date esistenti
Dim dateEsistenti As Object
Set dateEsistenti = CreateObject("Scripting.Dictionary")
Dim rng As Range, cell As Range
If rigaInizio > 2 Then
Set rng = ws.Range("A2:A" & rigaInizio - 1)
For Each cell In rng
If IsDate(cell.Value) Then
dateEsistenti(Format(cell.Value, "dd/mm/yyyy")) = True
End If
Next cell
End If
' Trova l'ultimo numero di concorso
Dim ultimoConcorso As Long
ultimoConcorso = 0
If rigaInizio > 2 Then
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row
If lastRow >= 2 Then
ultimoConcorso = Val(ws.Cells(lastRow, "B").Value)
End If
End If
MsgBox "Ultimo concorso in archivio: " & ultimoConcorso & vbCrLf & _
"Date già presenti: " & dateEsistenti.Count, vbInformation
' Scarica il file
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", url, False
http.setRequestHeader "User-Agent", "Mozilla/5.0"
http.send
If http.Status <> 200 Then
MsgBox "Errore download: " & http.Status, vbCritical
GoTo Cleanup
End If
contenuto = http.responseText
Dim linee() As String
linee = Split(contenuto, vbCrLf)
riga = rigaInizio
conteggioImportati = 0
conteggioTrovate = 0
Dim prossimoConcorso As Long
prossimoConcorso = ultimoConcorso + 1
Dim msgDebug As String
msgDebug = "=== DETTAGLIO ELABORAZIONE ===" & vbCrLf & vbCrLf
' Processa ogni riga
For i = 0 To UBound(linee)
linea = linee(i)
' Salta intestazioni
If InStr(1, LCase(linea), "archivio") = 0 And _
InStr(1, LCase(linea), "data") = 0 And _
InStr(1, LCase(linea), "lottologia") = 0 And _
Trim(linea) <> "" Then
' Sostituisci TAB con spazi
linea = Replace(linea, vbTab, " ")
Do While InStr(linea, " ") > 0
linea = Replace(linea, " ", " ")
Loop
linea = Trim(linea)
' Controllo formato: AAAA-MM-GG
If Len(linea) >= 10 And Mid(linea, 5, 1) = "-" And Mid(linea, 8, 1) = "-" Then
Dim anno As String, mese As String, giorno As String
Dim dataStr As String, dataFormatted As String
Dim dataVal As Date
anno = Left(linea, 4)
mese = Mid(linea, 6, 2)
giorno = Mid(linea, 9, 2)
If IsNumeric(anno) And IsNumeric(mese) And IsNumeric(giorno) Then
dataStr = giorno & "/" & mese & "/" & anno
On Error Resume Next
dataVal = CDate(dataStr)
On Error GoTo ErrorHandler
If IsDate(dataVal) Then
dataFormatted = Format(dataVal, "dd/mm/yyyy")
conteggioTrovate = conteggioTrovate + 1
' Log delle prime 10 date trovate
If conteggioTrovate <= 10 Then
msgDebug = msgDebug & "Riga " & i & ": " & dataFormatted & _
" | Valore: " & dataVal & vbCrLf
End If
' Importa solo se data > 28/02/2026 E non esiste già
If dataVal > ultimaDataArchivio Then
If Not dateEsistenti.Exists(dataFormatted) Then
' Split della riga
Dim dati() As String
dati = Split(linea, " ")
' Verifica di avere almeno 9 valori
If UBound(dati) >= 8 Then
ws.Cells(riga, "A").Value = dataVal
ws.Cells(riga, "A").NumberFormat = "dd/mm/yyyy"
ws.Cells(riga, "B").Value = prossimoConcorso
For j = 1 To 6
ws.Cells(riga, j + 2).Value = Val(dati(j))
Next j
ws.Cells(riga, "I").Value = Val(dati(7))
ws.Cells(riga, "J").Value = Val(dati(8))
dateEsistenti(dataFormatted) = True
riga = riga + 1
prossimoConcorso = prossimoConcorso + 1
conteggioImportati = conteggioImportati + 1
msgDebug = msgDebug & " -> IMPORTATA come concorso " & (prossimoConcorso - 1) & vbCrLf
End If
Else
msgDebug = msgDebug & " -> SALTA (già presente)" & vbCrLf
End If
Else
msgDebug = msgDebug & " -> SALTA (data <= 28/02/2026)" & vbCrLf
End If
End If
End If
End If
End If
Next i
msgDebug = msgDebug & vbCrLf & "=== RISULTATI ===" & vbCrLf
msgDebug = msgDebug & "Totale date trovate nel file: " & conteggioTrovate & vbCrLf
msgDebug = msgDebug & "Estrazioni importate: " & conteggioImportati & vbCrLf
If conteggioImportati > 0 Then
ws.Range("B" & rigaInizio & ":J" & riga - 1).NumberFormat = "0"
ws.Range("A" & rigaInizio & ":J" & riga - 1).Sort _
Key1:=ws.Range("A" & rigaInizio), Order1:=xlAscending, _
Header:=xlNo
MsgBox msgDebug & vbCrLf & "? Importazione completata!", vbInformation
Else
MsgBox msgDebug & vbCrLf & "?? Nessuna nuova estrazione importata", vbExclamation
End If
Cleanup:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set http = Nothing
Exit Sub
ErrorHandler:
MsgBox "Errore: " & Err.Description, vbCritical
Resume Cleanup
End Sub
Ciao LottoPython,
sai se sia possibile (e come), inserire il codice per l'aggiornamento con LiberOffice?
Ho provato con l'indicaz. sopra, ma non ho l'opzione "visualizza codice".
Grazie mille.
Lottopython
Advanced Member >PLATINUM<
>file archivio aggiornato
ciao mark non saprei proprio dirti come risolvere con liberoffice spero qualcuno sappia darti l'indicazione corretta,
da prestare attenzione quando si aggiorna
inserire :Annno, ultima data in archivio , e numero concorso in archivio
un caro saluto firefox.
ciao mark non saprei proprio dirti come risolvere con liberoffice spero qualcuno sappia darti l'indicazione corretta,
da prestare attenzione quando si aggiorna
inserire :Annno, ultima data in archivio , e numero concorso in archivio
un caro saluto firefox.
Baciccia4251
Advanced Member >PLATINUM<
Ciao sono Luca,
avevo deciso di abbandonare felicemente questo sito, limitandomi, ogni tanto a leggere qualcosa.
Ma Baciccia mi lasciò una breve lettera:
Ciao Luca,
Quando leggerai quanto segue io sarò col mio carissimo amico Satanasso.
Conoscendoti so che ti emozionerai. Ma fammi un piacere ridi non piangere.
La vita non è altro che un palcoscenico dove ho recitato cercando di dire
enormi stronzate sperando di far ridere e, perché no?, facendo sentire
tanto intelligente lo stronzetto di turno.
Mi farebbe piacere che tu, assieme ad altri.. Omissis
Omissis
Omissis
Omissis
Ultimamente alcuni nuovi iscritti, di questo ne sono sicuro, potrebbero migliorare il tutto.
Non foss'altro perché sanno quello che fanno, al contrario di me.
E sono persone che desiderano condividere quello che fanno, senza ritenersi Dei in possesso
delle verità assolute da far ricadere sul poveretto di turno.
Persone degne che condividono quello che fanno col cuore.
Nel caso facessero, per qualsiasi motivo, correzioni, ritocchi o quant'altro, vorrei
che li ringraziassi per mio conto. E che, al contrario di quanto faccio ad altri, non andrò la notte
a tiragli i piedi!
Omissis
Quindi leggendo quello che hai fatto, in ricordo del mio caro amico, scrivo per ringraziarti a nome del Baciccia e mio.
Questo vale per quelli, se ci saranno, che faranno correzioni, miglioramenti o perché no?, come direbbe il Baciccia, peggioramenti.
Sono rimasto davanti allo schermo pensando a come avrebbe chiuso il Baciccia, ma non ho trovato niente.
Allora ho cercato un'immagine che, in qualche modo rispecchiasse il suo desiderio di divertire:
Se non ci sono riuscito scusatemi.
Ultima estrazione Lotto
-
Estrazione del lotto
venerdì 13 marzo 2026Bari8421492414Cagliari4978420947Firenze4651728618Genova7271058083Milano5821356860Napoli5080255106Palermo6124752687Roma1544015466Torino7221316614Venezia0545345069Nazionale0713606381Estrazione Simbolotto
Firenze
1718242726
