Antonio Pagano
Senior Member
Ciao Ken allora non mi sbagliavo, infatti sto cercando di avere a video l'ultima estrazione.
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.
Nuovo script
- Creatore Discussione KEN
- Data di inizio
Baciccia4251
Advanced Member
Acc. Al l'Alzheimer non ho scaricato l'ultimo file, mi sono dimenticato che c'era stata una nuova estrazione Sabato.
Riscaricate al link segnato nell'altro post
Per vedere nel file txt qual è l'ultima estrazione basta aprirlo e scorrere
Acc. FC
Bacicciuk
Baciccia4251
Advanced Member
No. La Macro era solo un esempio, eventualmente da adattare.Baciccia sei simpaticissimo, grazie. Esequendo la macro di aggiorna archivio mi dà errore a : Me.TextBox1.Value = ultimaData.
Io la ho incollata qui dimmi se è nel poto giusto.
Sub AggiornaArchivioLocale()
Dim wsArchivio As Worksheet, wsAppoggio As Worksheet
Dim lastRowArchivio As Long
Dim currentRow As Long, startRow As Long
Dim i As Long
Dim numeri(4) As Integer
Dim ultimaDataArchivio As Date
Dim fso As Object, ts As Object
Dim fileContent As String, arrLines() As String
Dim dataEstrazione As Date
Dim currentDate As Date
Dim ruota As String
Dim continueProcessing As Boolean
' Disabilita aggiornamento schermo e calcoli automatici per migliorare la velocità
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Imposta i fogli di lavoro
Set wsArchivio = ThisWorkbook.Sheets("Archivio")
' Controlla se esiste il foglio Appoggio, se non esiste lo crea
On Error Resume Next
Set wsAppoggio = ThisWorkbook.Sheets("Appoggio")
If wsAppoggio Is Nothing Then
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)).name = "Appoggio"
Set wsAppoggio = ThisWorkbook.Sheets("Appoggio")
End If
On Error GoTo 0
' Ottieni l'ultima data dall'archivio, assume che la data sia nella colonna C
lastRowArchivio = wsArchivio.Cells(wsArchivio.Rows.count, 3).End(xlUp).row
If lastRowArchivio > 1 Then
ultimaDataArchivio = wsArchivio.Cells(lastRowArchivio, 3).Value
End If
' Leggi il file di testo locale
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fspenTextFile(ThisWorkbook.Path & "\storico_locale.txt", 1)
If Err.Number <> 0 Then
MsgBox "File di testo locale non trovato. Assicurati che il file 'storico_locale.txt' si trovi nella stessa cartella del file Excel.", vbCritical
GoTo CleanUp
End If
On Error GoTo 0
fileContent = ts.ReadAll
ts.Close
' Dividi il contenuto in righe
fileContent = Replace(fileContent, vbCrLf, vbLf)
arrLines = Split(fileContent, vbLf)
' Inizializza variabili
currentRow = 0
continueProcessing = True
currentDate = 0
' Pulisci il foglio Appoggio
wsAppoggio.Cells.Clear
' Processa le righe dal basso verso l'alto
For i = UBound(arrLines) To 0 Step -1
If Trim(arrLines(i)) <> "" Then
' Estrai la data e converti in formato data
dataEstrazione = DateSerial(left(arrLines(i), 4), Mid(arrLines(i), 6, 2), right(left(arrLines(i), 10), 2))
' Controlla se abbiamo raggiunto l'ultima data dell'archivio
If dataEstrazione <= ultimaDataArchivio Then
continueProcessing = False
Exit For
End If
' Se è una nuova data, crea una nuova riga
If currentDate <> dataEstrazione Then
currentRow = currentRow + 1
currentDate = dataEstrazione
wsAppoggio.Cells(currentRow, 3).NumberFormat = "dd/mm/yyyy"
wsAppoggio.Cells(currentRow, 3).Value = dataEstrazione
End If
' Estrai ruota e numeri
Dim parts() As String
parts = Split(Mid(arrLines(i), 12), vbTab)
ruota = parts(0)
' Copia i numeri nell'array come valori numerici
For j = 0 To 4
numeri(j) = val(parts(j + 1))
Next j
' Posiziona i numeri in base alla ruota
Select Case ruota
Case "BA"
wsAppoggio.Cells(currentRow, 4).Resize(1, 5).Value = numeri
Case "CA"
wsAppoggio.Cells(currentRow, 9).Resize(1, 5).Value = numeri
Case "FI"
wsAppoggio.Cells(currentRow, 14).Resize(1, 5).Value = numeri
Case "GE"
wsAppoggio.Cells(currentRow, 19).Resize(1, 5).Value = numeri
Case "MI"
wsAppoggio.Cells(currentRow, 24).Resize(1, 5).Value = numeri
Case "NA"
wsAppoggio.Cells(currentRow, 29).Resize(1, 5).Value = numeri
Case "PA"
wsAppoggio.Cells(currentRow, 34).Resize(1, 5).Value = numeri
Case "RM"
wsAppoggio.Cells(currentRow, 39).Resize(1, 5).Value = numeri
Case "TO"
wsAppoggio.Cells(currentRow, 44).Resize(1, 5).Value = numeri
Case "VE"
wsAppoggio.Cells(currentRow, 49).Resize(1, 5).Value = numeri
Case "RN" ' Ruota Nazionale
wsAppoggio.Cells(currentRow, 54).Resize(1, 5).Value = numeri
End Select
End If
Next i
' Ordina il foglio Appoggio per data crescente
If currentRow > 0 Then
With wsAppoggio.Sort
.SortFields.Clear
.SortFields.Add key:=wsAppoggio.Range("C1:C" & currentRow), Order:=xlAscending
.SetRange wsAppoggio.Range("C1:BF" & currentRow)
.Header = xlNo
.Apply
End With
' Copia in Archivio e aggiunge numerazione progressiva
lastRowArchivio = wsArchivio.Cells(wsArchivio.Rows.count, 3).End(xlUp).row
wsAppoggio.Range("C1:BF" & currentRow).Copy
wsArchivio.Cells(lastRowArchivio + 1, 3).PasteSpecial xlPasteValuesAndNumberFormats
' Converti i numeri da testo a valore
Dim rngNew As Range
Set rngNew = wsArchivio.Range(wsArchivio.Cells(lastRowArchivio + 1, 4), _
wsArchivio.Cells(lastRowArchivio + currentRow, wsArchivio.Columns.count))
rngNew.Value = rngNew.Value
' Ottieni l'ultimo valore nella colonna A
Dim lastValue As Long
lastValue = wsArchivio.Cells(wsArchivio.Rows.count, 1).End(xlUp).Value
' Aggiungi i numeri progressivi nella colonna A
startRow = lastRowArchivio + 1
For i = 1 To currentRow
wsArchivio.Cells(startRow + i - 1, 1).Value = lastValue + i
Next i
End If
CleanUp:
' Ripristina impostazioni
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
If currentRow > 0 Then
MsgBox "Aggiornamento completato. Aggiunte " & currentRow & " nuove estrazioni."
Else
MsgBox "Nessuna nuova estrazione da aggiungere."
End If
End Sub
Sub LeggiUltimaData()
Dim filePath As String
Dim ultimaRiga As String
Dim ultimaData As String
' Apri la finestra di dialogo per selezionare il file
filePath = Application.GetOpenFilename("File di testo (*.txt), *.txt")
' Verifica che un file sia stato selezionato
If filePath = "False" Then
MsgBox "Nessun file selezionato", vbExclamation
Exit Sub
End If
' Apri il file e leggi l'ultima riga
Open filePath For Input As #1
Do While Not EOF(1)
Line Input #1, ultimaRiga
Loop
Close #1
' Estrai la data dalla prima parte della riga (prima del tab)
ultimaData = left(ultimaRiga, 10)
' Assumendo che tu abbia già una TextBox chiamata TextBox1
Me.TextBox1.Value = ultimaData
End Sub
Però non l'avevo provata perché, ora ricordo, volevo chiederti qual era la data che desideravi, se l'ultima nel file txt, o se preferivi l'ultima estrazione in archivio.
Quest'ultima, nella prossima versione che posterò ci sarà.
Quindi basta un po' di pazienza.
Anche perché se vuoi vedere l'ultima data nel file txt (prima devi estrarre il contenuto scaricato e POI rinominare il file txt estratto col nome che ti ho detto) è sufficiente cliccare 2 volte sul file e scorrere.
Chiaroscuro?
Antonio Pagano
Senior Member
Ok aspetto aspetto Baciccia ver. 9.Basta ora guardo la partita grazie e buona serata.
Baciccia4251
Advanced Member
13.21 MB file on MEGA
Nel foglio Ken in alto appare la data dell'ultima estrazione in archivio. Aggiorna archivio Ken ora funziona così, seguite con attenzione per evitare quiquoqua:
1) Create una cartella dove ci sia solo il file Excel
2) In questa cartella scaricate il file zip ed estraetene il contenuto SENZA RINOMINARLO (deve essere l'unico TXT nella cartella)
3) lanciate "AggiornaArchivioKen" e, se non avete fatto cappelletti aggiornerà l'archivio (pensa la macro a rinominare il file)
Il tutto l'ho testato e funziona.
Che Budda vi sostenga, Visnù vi aiuti e la sfiga non vi perseguiti
Baciccin che ama il bon vin
Baciccia4251
Advanced Member
Baciccia4251
Advanced Member
L'aggiornamento DEVE riuscire. Se ha funzionato una volta DEVE funzionare anche le altre. Minaccia Excel, costringilo a sottostare ai tuoi voleri!
Scherzo: prova con l'allegato, ricorda devono stare, programma e txt, nella stessa cartella.
Ricorda che aprendo il file txt e scorrendolo fino alla fine potrai vedere l'ultima data che contiene. Perché è probabile che il file che hai utilizzato non fosse, solo San Crispino sa perché, aggiornato. Prova e fammi sapere
Baciccia
Antonio Pagano
Senior Member
Ken rileggi questo post, io non ho rinominato il file, l'ho soltantoo scompattato, lo dice Baciccia in questo post.13.21 MB file on MEGA
mega.nz
Nel foglio Ken in alto appare la data dell'ultima estrazione in archivio. Aggiorna archivio Ken ora funziona così, seguite con attenzione per evitare quiquoqua:
1) Create una cartella dove ci sia solo il file Excel
2) In questa cartella scaricate il file zip ed estraetene il contenuto SENZA RINOMINARLO (deve essere l'unico TXT nella cartella)
3) lanciate "AggiornaArchivioKen" e, se non avete fatto cappelletti aggiornerà l'archivio (pensa la macro a rinominare il file)
Il tutto l'ho testato e funziona.
Che Budda vi sostenga, Visnù vi aiuti e la sfiga non vi perseguiti
Baciccin che ama il bon vin
Ultima modifica:
Baciccia4251
Advanced Member
Bravo! Mi ero completamente dimenticato d'aver modificato la macro
Un accidiavolo alla mancanza di memoria.
L'Alzheimer a volte rompe davvero!
Scusa Ken dovevo darti il file Zip e non lo Txt rinominato.
Baciccia senza Memoria
KEN
Senior Member
fatto , come prima rimasto al 23 /11/2024
Baciccia4251
Advanced Member
Hai controllare che effettivamente fosse il file con l'ultima estrazione?
Apri il file Zip e poi il Txt, scorri fino in fondo e controlla l'ultima data.
Il comportamento ė anomalo.
Non potendo accedere al tuo computer non so come aiutarti.
Prova ancora questa apri come amministratore il Prompt dei comandi e digita:
Winget upgrade --all (se già non l'hai fatto).
Prova a reinstallare Office. Sai come controllare se i file di sistema sono integri? A volte capita che qualche programma li sovrascriva creando qualche problema.
Se le altre macro funzionano non è questione di permessi e via elencando.
Non ricordo le caratteristiche del tuo computer e quale versione di Kffice utilizzi.
Baciccia
Baciccia4251
Advanced Member
Office è lo stesso che ho io. Hai windows 10 ma con una CPU i7 potresti installare windows 11, anche perché tra un po' Win10 non sarà più supportato. Non ricordo ma credo sia possibile passare da win 10 a win 11 senza perdere dati e programmi anche se sarebbe preferibile una installazione ex novo. Se, e quando, deciderai di aggiornare il sistema operativo, posso darti alcune dritte che potrebbero facilitarti il tutto (se me le ricordo, comunque in internet si trovano spiegazioni dettagliate e consigli utili).
Quindi, a mio avviso, le macro (tutt'e due le macro Archivio) ti dovrebbero funzionare. Allora, anche se pensavo di no, potrebbe essere una questione di permessi delle Macro.
Dal Menu FILE di Excel vai su opzioni (in fondo):
Clicca su Opzioni
Clicca sull'ultima voce Centro protezione
Clicca su Impostazioni Centro protezione... (sulla destra)
Clicca su Impostazioni delle macro (a sinistra più o meno a metà):
Controlla che sia così, se non lo è modifica
Se continuasse a non funzionare torna in quest'ultimo riquadro e prova a selezionare l'ultima voce: Attivare le macro VBA (scelta sconsigliata)
solo per il tempo necessario a verificare se ora funziona. Poi dopo la verifica, positiva o negativa che sia, torna al quadro e rimettilo come ti ho detto.
Fammi sapere
KEN
Senior Member
Era già tutto impostato come mi hai mostrato sei molto gentile a aiutarmi grazie .
Purtroppo x win 11 dice che non è compatibile e da prossimo ottobre non avrò più aggiornamenti.
Comunque ho provato varie combinazioni dal tuo excel in queste poche estrazioni e non ho avuto riscontri positivi come speravo , se no riesco aggiornare pazienza provo altre strade .
Purtroppo x win 11 dice che non è compatibile e da prossimo ottobre non avrò più aggiornamenti.
Comunque ho provato varie combinazioni dal tuo excel in queste poche estrazioni e non ho avuto riscontri positivi come speravo , se no riesco aggiornare pazienza provo altre strade .
Baciccia4251
Advanced Member
Win11 si può installare anche in una macchina senza requisiti.
E' molto, molto semplice. Ma non voglio complicarti la vita.
Comunque con un po' di pazienza vedrò se riesco a trovare un escamotage per aggiornare il tuo archivio.
Ciao
Baciccia
E' molto, molto semplice. Ma non voglio complicarti la vita.
Comunque con un po' di pazienza vedrò se riesco a trovare un escamotage per aggiornare il tuo archivio.
Ciao
Baciccia
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 30 novembre 2024Bari2546418389Cagliari1380425351Firenze8726103402Genova0369744470Milano6355335315Napoli9066766923Palermo5958662429Roma5843230550Torino5334171509Venezia9073822239Nazionale2581373058Estrazione Simbolotto
Torino
1410344416
