EXCEL E DINTORNI

[Kikkos73]

Buonasera a tutti voi. Sperando di fare cosa gradita, invio il link del foglio excel aggiornato a febbraio
https://www.transfernow.net/dl/202603070zE82Z0j

Buona domenica

FRancesco

Grazie!

 

[Alien.]

Ciao firefox ,il programma suggerito a BACICCIA ma lo avevo perso come un ago sul pagliaio ,come lo aggiorni ? Inoltre mi dice rischio sicurezza me lo ha bloccato sai come risolvere, grazie.

 

[The Wolf]

Buonasera a tutti voi. Sperando di fare cosa gradita, invio il link del foglio excel aggiornato a febbraio
https://www.transfernow.net/dl/202603070zE82Z0j

Buona domenica

FRancesco

Grazie

 

[Alien.]

OK ciao The Wolf risolto ma come si aggiorna ? a mano ?

 

[The Wolf]

Buonasera a tutti voi. Sperando di fare cosa gradita, invio il link del foglio excel aggiornato a febbraio
https://www.transfernow.net/dl/202603070zE82Z0j

Buona domenica

FRancesco

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]

tx dx (archivio)
visualizza codice ,
incolla macro ,
tasto salva in alto a sx

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

 

[firefox]

Buonasera a tutti. Io lo aggiorno facendo il copia incolla dopo aver esportato l'archivio da spaziometria.
Ma Lottopython, che saluto, ci ha regalato una eccellente "chicca". Grazie
Buona serata a tutti
Francesco

 

[Mark555]

tx dx (archivio)
visualizza codice ,
incolla macro ,
tasto salva in alto a sx
Vedi l'allegato 2312941

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]

>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.