Nuovo script

[Antonio Pagano]

Sembra che vada adesso con il nuovo txt che hai messo mi dice nessuna nuova estrazione da aggiungere ma strano che quella di ieri sera non sia ancora disponibile.

Ciao Ken allora non mi sbagliavo, infatti sto cercando di avere a video l'ultima estrazione.

 

[Baciccia4251]

Ciao Ken allora non mi sbagliavo, infatti sto cercando di avere a video l'ultima estrazione.

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]

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

No. La Macro era solo un esempio, eventualmente da adattare.
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]

Ok aspetto aspetto Baciccia ver. 9.Basta ora guardo la partita grazie e buona serata.

 

[Baciccia4251]

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

 

[Baciccia4251]

Wuaoo ! il ric trivellato fa a caso mio ma ce tanto di più molto bello e completo che può aiutare a sceglire .
Ci ho messo un pò non riuscivo a sbloccare la macro ora va grazie Baciccia .

 

[KEN]

Al momento non si è aggiornato , domani riprovo.

 

[KEN]

No non aggiorna dice nessuna nuova estrazione
La maledizione trionfa

 

[Baciccia4251]

No non aggiorna dice nessuna nuova estrazione
La maledizione trionfa

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]

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

Ken rileggi questo post, io non ho rinominato il file, l'ho soltantoo scompattato, lo dice Baciccia in questo post.

 

[Baciccia4251]

Ken rileggi questo post, io non ho rinominato il file, l'ho soltantoo scompattato, lo dice Baciccia in questo post.

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]

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

fatto , come prima rimasto al 23 /11/2024

 

[Baciccia4251]

fatto , come prima rimasto al 23 /11/2024

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

 

[KEN]

Processore Intel(R) Core(TM) i7-6700HQ CPU @ 2.60GHz 2.59 GHz
RAM installata 8,00 GB (7,84 GB utilizzabile)
Tipo sistema Sistema operativo a 64 bit, processore basato su x64
Penna e tocco Nessun input penna o tocco disponibile per questo schermo
windows 10
office 2021