Personalmente non so fare gli script e, tantomeno, so cosa sia un archivio FT
e non so nemmeno se ho capito cosa voleva
Proprio per questo
ho provato a fare una macro per Excel (come suona bene! Ho provato. In realtà mi sono limitato a chiedere una macro alla AI su quanto avevo capito io (orrrrrore!)
Non so se le può servire, non ho neanche controllato se i risultati sono corretti. Ma, magari, il mio ntervento smuove i sapientoni che nascondono la testa sotto la sabbia. A che serve un Forum se neanche rispondete?
Sub RitardiOrizzontali()
Dim wsArchivio As Worksheet
Dim wsRisultati As Worksheet
Dim ultimaRiga As Long, i As Long, j As Long, k As Long
' Imposta i fogli di lavoro
Set wsArchivio = ThisWorkbook.Sheets("Archivio")
' Crea nuovo foglio per i risultati se non esiste
On Error Resume Next
Set wsRisultati = ThisWorkbook.Sheets("Ritardi_Estratti")
On Error GoTo 0
If wsRisultati Is Nothing Then
Set wsRisultati = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsRisultati.Name = "Ritardi_Estratti"
Else
wsRisultati.Cells.Clear
End If
' Trova l'ultima riga con dati
ultimaRiga = wsArchivio.Cells(wsArchivio.Rows.Count, "A").End(xlUp).Row
' Array delle ruote con le loro colonne
Dim ruote As Variant
ruote = Array("Bari|D:H", "Cagliari|I:M", "Firenze|N:R", "Genova|S:W", "Milano|X:AB", _
"Napoli|AC:AG", "Palermo|AH:AL", "Roma|AM:AQ", "Torino|AR:AV", "Venezia|AW:BA", "Nazionale|BB:BF")
' Intestazioni prima riga
wsRisultati.Cells(1, 1) = "Data"
Dim colHeader As Long
colHeader = 2
For r = 0 To UBound(ruote)
Dim ruotaNome As String
ruotaNome = Split(ruote(r), "|")(0)
For n = 1 To 5
wsRisultati.Cells(1, colHeader) = ruotaNome & " N" & n
wsRisultati.Cells(1, colHeader + 1) = "Rit."
colHeader = colHeader + 2
Next n
' Aggiungi colonna separatrice dopo ogni ruota (tranne l'ultima)
If r < UBound(ruote) Then
wsRisultati.Cells(1, colHeader) = ""
colHeader = colHeader + 1
End If
Next r
' Righe dati
Dim rigaRisultati As Long
rigaRisultati = 2
' Per le ultime 20 estrazioni
For i = ultimaRiga To ultimaRiga - 19 Step -1
' Scrivi la data
wsRisultati.Cells(rigaRisultati, 1) = wsArchivio.Cells(i, 3).Value
' Colonna di partenza per i numeri e ritardi
Dim colRisultati As Long
colRisultati = 2
' Per ogni ruota
For r = 0 To UBound(ruote)
Dim colInizio As String, colFine As String
colInizio = Split(Split(ruote(r), "|")(1), ":")(0)
colFine = Split(Split(ruote(r), "|")(1), ":")(1)
' Per ogni numero nella ruota
For col = Range(colInizio & "1").Column To Range(colFine & "1").Column
Dim numeroEstratto As Long
numeroEstratto = wsArchivio.Cells(i, col).Value
' Se è un numero valido
If numeroEstratto > 0 Then
' Calcola il ritardo
Dim ritardo As Long
ritardo = 0
' Controlla le estrazioni precedenti
For j = i - 1 To 9 Step -1
Dim trovato As Boolean
trovato = False
' Cerca il numero nella stessa ruota
For k = Range(colInizio & "1").Column To Range(colFine & "1").Column
If wsArchivio.Cells(j, k).Value = numeroEstratto Then
trovato = True
Exit For
End If
Next k
If trovato Then
Exit For
Else
ritardo = ritardo + 1
End If
Next j
' Scrivi numero e ritardo
wsRisultati.Cells(rigaRisultati, colRisultati) = numeroEstratto
wsRisultati.Cells(rigaRisultati, colRisultati + 1) = ritardo
End If
colRisultati = colRisultati + 2
Next col
' Aggiungi colonna separatrice dopo ogni ruota (tranne l'ultima)
If r < UBound(ruote) Then
wsRisultati.Cells(rigaRisultati, colRisultati) = ""
colRisultati = colRisultati + 1
End If
Next r
rigaRisultati = rigaRisultati + 1
Next i
' Formattazione
With wsRisultati.Range("A1").CurrentRegion
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
With .Rows(1)
.Font.Bold = True
.Interior.ColorIndex = 15
End With
' Colora le colonne separatrici
Dim sepCol As Long
sepCol = 12 ' Prima colonna separatrice (dopo i primi 5 numeri e ritardi di Bari)
Do While sepCol <= .Columns.Count
.Columns(sepCol).Interior.ColorIndex = 15
sepCol = sepCol + 11 ' Prossima colonna separatrice (5 numeri * 2 colonne + 1 separatore = 11)
Loop
End With
' Adatta larghezza colonne
wsRisultati.Columns.AutoFit
' Imposta una larghezza minima per le colonne separatrici
sepCol = 12
Do While sepCol <= wsRisultati.Range("A1").CurrentRegion.Columns.Count
wsRisultati.Columns(sepCol).ColumnWidth = 2
sepCol = sepCol + 11
Loop
MsgBox "Analisi completata! I risultati sono nel foglio 'Ritardi_Estratti'."
End Sub
Il risultato della macro:
Salutammo
Baciccia
