Questa è la macro, con mille problemi ancora da risolvere
Option Explicit
Private Type ultimoEsito
Data As Date
Codice As String
Concorso As String
End Type
Public Sub Futuro2Macro()
On Error GoTo ErrorHandler
' Inizializzazione
Dim ws As Worksheet
Dim wsDest As Worksheet
Set ws = ThisWorkbook.Worksheets("Archivio")
Set wsDest = ThisWorkbook.Worksheets("Missione")
wsDest.Cells.Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Input parametri
Dim ruotaSpia As Integer
ruotaSpia = InputBox("Ruota della spia (1-11)" & vbCrLf & _
"1=Bari, 2=Cagliari, 3=Firenze, 4=Genova, 5=Milano" & vbCrLf & _
"6=Napoli, 7=Palermo, 8=Roma, 9=Torino, 10=Venezia, 11=Nazionale", , 1)
If ruotaSpia < 1 Or ruotaSpia > 11 Then
MsgBox "Ruota non valida!"
GoTo CleanExit
End If
Dim ruotaGioco As Integer
ruotaGioco = InputBox("Ruota di gioco (1-11)" & vbCrLf & _
"1=Bari, 2=Cagliari, 3=Firenze, 4=Genova, 5=Milano" & vbCrLf & _
"6=Napoli, 7=Palermo, 8=Roma, 9=Torino, 10=Venezia, 11=Nazionale", , ruotaSpia)
If ruotaGioco < 1 Or ruotaGioco > 11 Then
MsgBox "Ruota non valida!"
GoTo CleanExit
End If
Dim numeroSpia As Integer
numeroSpia = InputBox("Numero Spia (1-90)", , 82)
If numeroSpia < 1 Or numeroSpia > 90 Then
MsgBox "Numero non valido!"
GoTo CleanExit
End If
Dim colpiGioco As Integer
colpiGioco = InputBox("Numero colpi di gioco", , 18)
If colpiGioco < 1 Then
MsgBox "Numero colpi non valido!"
GoTo CleanExit
End If
Dim sorte As Integer
sorte = CInt(InputBox("Quale sorte vuoi considerare (1-3)" & vbCrLf & _
"1=Ambata, 2=Ambo, 3=Terno", "Sorte", 1))
If sorte < 1 Or sorte > 3 Then
MsgBox "Sorte non valida!"
GoTo CleanExit
End If
' Input numero estrazioni da analizzare
Dim numEstrazioni As Long
numEstrazioni = CLng(InputBox("Numero di estrazioni da analizzare" & vbCrLf & _
"(Suggerito: 456 estrazioni = 3 anni)", , 456))
If numEstrazioni < 1 Then
MsgBox "Numero estrazioni non valido!"
GoTo CleanExit
End If
' Ottieni colonne per entrambe le ruote
Dim colSpia_Inizio As Integer, colSpia_Fine As Integer
Dim colGioco_Inizio As Integer, colGioco_Fine As Integer
' Colonne ruota spia
GetColonneRuota ruotaSpia, colSpia_Inizio, colSpia_Fine
' Colonne ruota gioco
GetColonneRuota ruotaGioco, colGioco_Inizio, colGioco_Fine
' Cerca ultima riga
Dim ultimaRiga As Long
ultimaRiga = ws.Cells(ws.Rows.count, "C").End(xlUp).row
' Imposta riga iniziale in base al numero di estrazioni richiesto
Dim inizioAnalisi As Long
' Se è richiesta la Nazionale, verifica che non si vada prima del 2005
If ruotaSpia = 11 Or ruotaGioco = 11 Then
Dim rigaNazionale As Long
rigaNazionale = Application.WorksheetFunction.Match(DateValue("1/1/2005"), _
ws.Range("C9:C" & ultimaRiga), 1) + 8
inizioAnalisi = Application.WorksheetFunction.Max(rigaNazionale, ultimaRiga - numEstrazioni + 1)
Else
inizioAnalisi = ultimaRiga - numEstrazioni + 1
If inizioAnalisi < 9 Then inizioAnalisi = 9
End If
' Array per statistiche
Dim statCoppie(1 To 90, 1 To 90) As Long
Dim ritardoCoppie(1 To 90) As Long
Dim presenzePosizioni(1 To 90, 1 To 5) As Long
' Inizializzazione array
Dim i As Integer, j As Integer, k As Integer
For i = 1 To 90
ritardoCoppie(i) = 0
For j = 1 To 90
statCoppie(i, j) = 0
Next j
For k = 1 To 5
presenzePosizioni(i, k) = 0
Next k
Next i
' Contatori
Dim numCasiTrovati As Long
numCasiTrovati = 0
' Ricerca
Dim riga As Long
For riga = inizioAnalisi To ultimaRiga
' Progress update ogni 100 righe
If riga Mod 100 = 0 Then
Application.StatusBar = "Analisi riga " & riga & " di " & ultimaRiga & " - Casi trovati: " & numCasiTrovati
DoEvents
End If
' Verifica presenza numero spia
If VerificaNumero(ws, riga, numeroSpia, colSpia_Inizio, colSpia_Fine) Then
numCasiTrovati = numCasiTrovati + 1
' Array per tenere traccia dei numeri trovati in tutti i colpi
Dim numeriTrovatiTotali() As Integer
ReDim numeriTrovatiTotali(1 To 90)
Dim numTotali As Integer
numTotali = 0
' Analizza i colpi successivi per trovare coppie
Dim colpo As Long
For colpo = 1 To colpiGioco
If riga + colpo <= ultimaRiga Then
' Leggi numeri della ruota di gioco per questo colpo
Dim numeriColpo() As Integer
Dim numTrovati As Integer
numTrovati = GetNumeriEstrazione(ws, riga + colpo, colGioco_Inizio, colGioco_Fine, numeriColpo)
' Aggiungi i numeri trovati all'array totale e aggiorna presenze posizioni
Dim n As Integer
For n = 1 To numTrovati
Dim num As Integer
num = numeriColpo
numeriTrovatiTotali(num) = 1
presenzePosizioni(num, n) = presenzePosizioni(num, n) + 1
Next n
End If
Next colpo
' Aggiorna statistiche per tutte le possibili coppie dei numeri trovati
For i = 1 To 90
If numeriTrovatiTotali(i) = 1 Then
For j = i + 1 To 90
If numeriTrovatiTotali(j) = 1 Then
statCoppie(i, j) = statCoppie(i, j) + 1
End If
Next j
End If
Next i
' Calcola ritardi per questo caso
For i = 1 To 89
For j = i + 1 To 90
Dim ritardoCorrente As Long
ritardoCorrente = CalcolaRitardoCoppia(ws, ultimaRiga, i, j, colGioco_Inizio, colGioco_Fine)
' Aggiorna il ritardo massimo per entrambi i numeri della coppia
If ritardoCorrente > ritardoCoppie(i) Then ritardoCoppie(i) = ritardoCorrente
If ritardoCorrente > ritardoCoppie(j) Then ritardoCoppie(j) = ritardoCorrente
Next j
Next i
End If
Next riga
' Calcola il ritardo della spia
Dim ritardoSpia As Long
ritardoSpia = CalcolaRitardoNumero(ws, ultimaRiga, numeroSpia, colSpia_Inizio, colSpia_Fine, ultimaRiga)
' Prepara array per i risultati
Dim numeriFrequenti(1 To 15, 1 To 7) As Variant
Call TrovaNumeriFrequenti(statCoppie, ritardoCoppie, presenzePosizioni, numCasiTrovati, _
numeriFrequenti, ws, ultimaRiga, colGioco_Inizio, colGioco_Fine)
' Salva risultati
Call SalvaReport(wsDest, numeriFrequenti, numeroSpia, numCasiTrovati, _
ruotaSpia, ruotaGioco, colpiGioco, ritardoSpia, sorte, _
inizioAnalisi, ultimaRiga, ws, presenzePosizioni)
' Messaggio completamento
MsgBox "Analisi completata!" & vbCrLf & _
"Trovati " & numCasiTrovati & " casi della spia " & numeroSpia & vbCrLf & _
"Ritardo attuale: " & ritardoSpia & vbCrLf & _
"I risultati sono stati salvati nel foglio 'Missione'.", vbInformation
CleanExit:
' Pulizia
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Exit Sub
ErrorHandler:
MsgBox "Errore: " & Err.Description & vbCrLf & _
"Linea: " & Erl, vbCritical
Resume CleanExit
End Sub
Private Function Format2(ByVal numero As Long) As String
Format2 = right$("00" & CStr(numero), 2)
End Function
Private Function OttieniNomeRuota(ByVal indice As Integer) As String
Select Case indice
Case 1: OttieniNomeRuota = "Bari"
Case 2: OttieniNomeRuota = "Cagliari"
Case 3: OttieniNomeRuota = "Firenze"
Case 4: OttieniNomeRuota = "Genova"
Case 5: OttieniNomeRuota = "Milano"
Case 6: OttieniNomeRuota = "Napoli"
Case 7: OttieniNomeRuota = "Palermo"
Case 8: OttieniNomeRuota = "Roma"
Case 9: OttieniNomeRuota = "Torino"
Case 10: OttieniNomeRuota = "Venezia"
Case 11: OttieniNomeRuota = "Nazionale"
Case Else: OttieniNomeRuota = "Ruota non valida"
End Select
End Function
Private Function OttieniNomeSorte(ByVal sorte As Integer) As String
Select Case sorte
Case 1: OttieniNomeSorte = "Ambata"
Case 2: OttieniNomeSorte = "Ambo"
Case 3: OttieniNomeSorte = "Terno"
Case Else: OttieniNomeSorte = "Non specificata"
End Select
End Function
Private Sub GetColonneRuota(ByVal ruota As Integer, ByRef colInizio As Integer, ByRef colFine As Integer)
Select Case ruota
Case 1: colInizio = 4: colFine = 8 ' Bari
Case 2: colInizio = 9: colFine = 13 ' Cagliari
Case 3: colInizio = 14: colFine = 18 ' Firenze
Case 4: colInizio = 19: colFine = 23 ' Genova
Case 5: colInizio = 24: colFine = 28 ' Milano
Case 6: colInizio = 29: colFine = 33 ' Napoli
Case 7: colInizio = 34: colFine = 38 ' Palermo
Case 8: colInizio = 39: colFine = 43 ' Roma
Case 9: colInizio = 44: colFine = 48 ' Torino
Case 10: colInizio = 49: colFine = 53 ' Venezia
Case 11: colInizio = 54: colFine = 58 ' Nazionale
End Select
End Sub
Private Function GetNumeriEstrazione(ByRef ws As Worksheet, ByVal riga As Long, _
ByVal colInizio As Integer, ByVal colFine As Integer, _
ByRef numeriTrovati() As Integer) As Integer
Dim numeri(1 To 5) As Integer
Dim count As Integer
count = 0
' Inizializzazione esplicita
Dim i As Integer
For i = 1 To 5
numeri(i) = 0
Next i
Dim col As Integer
For col = colInizio To colFine
Dim valoreCell As Variant
valoreCell = ws.Cells(riga, col).Value
If IsNumeric(valoreCell) Then
count = count + 1
If count <= 5 Then
numeri(count) = CInt(valoreCell)
End If
End If
Next col
If count > 0 Then
ReDim numeriTrovati(1 To count)
For i = 1 To count
numeriTrovati(i) = numeri(i)
Next i
Else
ReDim numeriTrovati(1 To 1)
numeriTrovati(1) = 0
End If
GetNumeriEstrazione = count
End Function
Private Function VerificaNumero(ByRef ws As Worksheet, ByVal riga As Long, _
ByVal numero As Integer, ByVal colInizio As Integer, _
ByVal colFine As Integer) As Boolean
Dim col As Integer
For col = colInizio To colFine
Dim valoreCell As Variant
valoreCell = ws.Cells(riga, col).Value
If IsNumeric(valoreCell) Then
If CInt(valoreCell) = numero Then
VerificaNumero = True
Exit Function
End If
End If
Next col
VerificaNumero = False
End Function
Private Function CalcolaRitardoNumero(ByRef ws As Worksheet, ByVal rigaInizio As Long, _
ByVal numero As Integer, ByVal colInizio As Integer, _
ByVal colFine As Integer, ByVal ultimaRiga As Long) As Long
Dim ritardo As Long
ritardo = 0
Dim riga As Long
For riga = rigaInizio + 1 To ultimaRiga
ritardo = ritardo + 1
If VerificaNumero(ws, riga, numero, colInizio, colFine) Then Exit For
Next riga
CalcolaRitardoNumero = ritardo
End Function
Private Function CalcolaRitardoCoppia(ByRef ws As Worksheet, ByVal ultimaRiga As Long, _
ByVal num1 As Integer, ByVal num2 As Integer, _
ByVal colInizio As Integer, ByVal colFine As Integer) As Long
Dim ritardo As Long
ritardo = 0
' Cerca all'indietro partendo dall'ultima riga
Dim riga As Long
For riga = ultimaRiga To 1 Step -1
' Se trova almeno uno dei due numeri, esce dal ciclo
If VerificaNumero(ws, riga, num1, colInizio, colFine) Or _
VerificaNumero(ws, riga, num2, colInizio, colFine) Then
Exit For
End If
ritardo = ritardo + 1
Next riga
CalcolaRitardoCoppia = ritardo
End Function
Private Function GetEstrattiCoppia(ByRef ws As Worksheet, ByVal riga As Long, _
ByVal num1 As Integer, ByVal num2 As Integer, _
ByVal colInizio As Integer, ByVal colFine As Integer) As String
' Verifica la presenza dei numeri nella riga specificata
Dim trovato1 As Boolean, trovato2 As Boolean
trovato1 = False
trovato2 = False
Dim col As Integer
For col = colInizio To colFine
Dim valoreCell As Variant
valoreCell = ws.Cells(riga, col).Value
If IsNumeric(valoreCell) Then
If CInt(valoreCell) = num1 Then trovato1 = True
If CInt(valoreCell) = num2 Then trovato2 = True
End If
Next col
' Formatta il risultato in base ai numeri trovati
If trovato1 And trovato2 Then
GetEstrattiCoppia = "CA." & Format2(num1) & "." & Format2(num2)
ElseIf trovato1 Then
GetEstrattiCoppia = "CA..." & Format2(num1) & ".."
ElseIf trovato2 Then
GetEstrattiCoppia = "CA..." & Format2(num2) & ".."
Else
GetEstrattiCoppia = "CA....."
End If
End Function
Private Function FormatPresenzePosizioni(ByVal num1 As Integer, ByVal num2 As Integer, _
ByRef presenzePosizioni() As Long) As String
' Formatta presenze per il primo numero
Dim str1 As String
str1 = Format2(presenzePosizioni(num1, 1)) & "[" & _
Format2(presenzePosizioni(num1, 1)) & "." & _
Format2(presenzePosizioni(num1, 2)) & "." & _
Format2(presenzePosizioni(num1, 3)) & "." & _
Format2(presenzePosizioni(num1, 4)) & "." & _
Format2(presenzePosizioni(num1, 5)) & "]"
' Formatta presenze per il secondo numero
Dim str2 As String
str2 = Format2(presenzePosizioni(num2, 1)) & "[" & _
Format2(presenzePosizioni(num2, 1)) & "." & _
Format2(presenzePosizioni(num2, 2)) & "." & _
Format2(presenzePosizioni(num2, 3)) & "." & _
Format2(presenzePosizioni(num2, 4)) & "." & _
Format2(presenzePosizioni(num2, 5)) & "]"
' Combina le due stringhe
FormatPresenzePosizioni = str1 & " - " & str2
End Function
Private Function TrovaUltimoEsito(ByRef ws As Worksheet, ByVal ultimaRiga As Long, _
ByVal num1 As Integer, ByVal num2 As Integer, _
ByVal colInizio As Integer, ByVal colFine As Integer) As ultimoEsito
Dim riga As Long
Dim trovato1 As Boolean, trovato2 As Boolean
Dim risultato As ultimoEsito
' Cerca dall'ultima riga verso l'alto
For riga = ultimaRiga To 1 Step -1
trovato1 = False
trovato2 = False
' Verifica presenza numeri
Dim col As Integer
For col = colInizio To colFine
Dim valoreCell As Variant
valoreCell = ws.Cells(riga, col).Value
If IsNumeric(valoreCell) Then
If CInt(valoreCell) = num1 Then trovato1 = True
If CInt(valoreCell) = num2 Then trovato2 = True
End If
Next col
' Se trovato almeno un numero, salva la data
If trovato1 Or trovato2 Then
risultato.Data = ws.Cells(riga, "C").Value
risultato.Codice = Format(ws.Cells(riga, "A").Value, "00000")
risultato.Concorso = Format(ws.Cells(riga, "B").Value, "000")
Exit For
End If
Next riga
TrovaUltimoEsito = risultato
End Function
Private Sub TrovaNumeriFrequenti(ByRef statCoppie() As Long, _
ByRef ritardoCoppie() As Long, _
ByRef presenzePosizioni() As Long, _
ByVal numCasiTrovati As Long, _
ByRef numeriFrequenti() As Variant, _
ByRef ws As Worksheet, _
ByVal ultimaRiga As Long, _
ByVal colInizio As Integer, _
ByVal colFine As Integer)
Dim coppieArray(1 To 4005, 1 To 7) As Variant ' Array per tutte le possibili coppie
Dim coppiaCont As Long
coppiaCont = 0
' Inizializzazione coppieArray
Dim i As Integer, j As Integer
For i = 1 To 4005
For j = 1 To 7
coppieArray(i, j) = 0
Next j
Next i
' Inizializzazione numeriFrequenti
For i = 1 To 15
For j = 1 To 7
numeriFrequenti(i, j) = 0
Next j
Next i
' Genera tutte le possibili coppie e calcola le loro statistiche
For i = 1 To 89
For j = i + 1 To 90
coppiaCont = coppiaCont + 1
' Calcola la frequenza effettiva della coppia
Dim freq As Long
freq = statCoppie(i, j)
If freq > 0 Then
coppieArray(coppiaCont, 1) = i ' Primo numero della coppia
coppieArray(coppiaCont, 2) = j ' Secondo numero della coppia
coppieArray(coppiaCont, 3) = freq ' Frequenza della coppia
' Calcola il ritardo serie corrente
Dim ritardoSerie As Long
ritardoSerie = CalcolaRitardoCoppia(ws, ultimaRiga, i, j, colInizio, colFine)
coppieArray(coppiaCont, 4) = ritardoSerie
' Il ritardo max è il massimo dei ritardi serie incontrati
Dim ritardoMax As Long
ritardoMax = Application.WorksheetFunction.Max(ritardoCoppie(i), ritardoCoppie(j))
coppieArray(coppiaCont, 5) = ritardoMax
coppieArray(coppiaCont, 6) = IIf(numCasiTrovati > 0, (freq / numCasiTrovati) * 100, 0)
coppieArray(coppiaCont, 7) = "in corso"
End If
Next j
Next i
' Ordina per frequenza (bubble sort)
Dim k As Integer, temp As Variant
Dim scambio As Boolean
Do
scambio = False
For i = 1 To coppiaCont - 1
If coppieArray(i, 3) < coppieArray(i + 1, 3) Then
' Scambia le righe
For k = 1 To 7
temp = coppieArray(i, k)
coppieArray(i, k) = coppieArray(i + 1, k)
coppieArray(i + 1, k) = temp
Next k
scambio = True
End If
Next i
Loop While scambio
' Copia i primi 15 risultati (solo se hanno frequenza > 0)
Dim risultatiCopiati As Integer
risultatiCopiati = 0
i = 1
Do While risultatiCopiati < 15 And i <= coppiaCont
If coppieArray(i, 3) > 0 Then
risultatiCopiati = risultatiCopiati + 1
For j = 1 To 7
numeriFrequenti(risultatiCopiati, j) = coppieArray(i, j)
Next j
End If
i = i + 1
Loop
End Sub
Private Sub SalvaReport(ByRef wsDest As Worksheet, ByRef numeriFrequenti() As Variant, _
ByVal numeroSpia As Integer, ByVal numCasiTrovati As Long, _
ByVal ruotaSpia As Integer, ByVal ruotaGioco As Integer, _
ByVal colpiGioco As Integer, ByVal ritardoSpia As Long, _
ByVal sorte As Integer, ByVal inizioAnalisi As Long, _
ByVal ultimaRiga As Long, ByRef wsArchivio As Worksheet, _
ByRef presenzePosizioni() As Long)
Dim i As Integer
Dim riga As Long
' Intestazione
With wsDest.Range("A1")
.Value = "*** FUTURO 2 *** Mission Impossible *** Project By Batter © *** Script List By Mike58 ***"
.Font.Bold = True
.Font.Size = 14
.HorizontalAlignment = xlCenter
End With
wsDest.Range("A1:K1").Merge
' Info spia e status
With wsDest.Cells(3, 1)
.Value = "Spia " & numeroSpia & " su " & OttieniNomeRuota(ruotaSpia) & " - Ritarda da: " & ritardoSpia
.Font.Bold = True
End With
With wsDest.Cells(4, 1)
.Value = IIf(ritardoSpia < colpiGioco, "SPIA ATTIVA", "SPIA NON ATTIVA")
.Font.Bold = True
.Font.ColorIndex = 3 ' Verde
End With
' Info analisi
With wsDest.Cells(5, 1)
.Value = "Coppie più frequenti entro " & colpiGioco & " colpi sulla ruota di " & _
OttieniNomeRuota(ruotaGioco) & " per sorte di " & OttieniNomeSorte(sorte)
.Font.Bold = True
End With
With wsDest.Cells(6, 1)
.Value = "Casi trovati: " & numCasiTrovati & _
" dal " & Format(wsArchivio.Cells(inizioAnalisi, "C").Value, "dd/mm/yyyy") & _
" al " & Format(wsArchivio.Cells(ultimaRiga, "C").Value, "dd/mm/yyyy")
.Font.Bold = True
End With
' Intestazioni tabella
Dim titoli(1 To 11) As String
titoli(1) = "Casi"
titoli(2) = "Numeri"
titoli(3) = "Presenze"
titoli(4) = "esito %"
titoli(5) = "ret_estratti fin-colpi"
titoli(6) = "colpo"
titoli(7) = "Data esito ultimo"
titoli(8) = "Ritardo serie"
titoli(9) = "Presenza serie"
titoli(10) = "Rit. Max"
titoli(11) = "Pres ambate singole e in Posizioni"
Dim rngHeader As Range
Set rngHeader = wsDest.Range("A8:K8")
rngHeader.Value = titoli
With rngHeader
.Font.Bold = True
.Interior.Color = RGB(200, 200, 200)
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
' Ottieni colonne per la ruota di gioco
Dim colGioco_Inizio As Integer, colGioco_Fine As Integer
GetColonneRuota ruotaGioco, colGioco_Inizio, colGioco_Fine
' Dati
riga = 9
For i = 1 To 15
If numeriFrequenti(i, 3) > 0 Then ' Se ha frequenza > 0
With wsDest
.Cells(riga, 1).Value = i
.Cells(riga, 2).Value = Format2(numeriFrequenti(i, 1)) & "." & Format2(numeriFrequenti(i, 2))
.Cells(riga, 3).Value = numeriFrequenti(i, 3)
.Cells(riga, 4).Value = Format(numeriFrequenti(i, 6), "0.00") & "%"
.Cells(riga, 5).Value = GetEstrattiCoppia(wsArchivio, ultimaRiga, _
numeriFrequenti(i, 1), _
numeriFrequenti(i, 2), _
colGioco_Inizio, colGioco_Fine)
.Cells(riga, 6).Value = CalcolaRitardoCoppia(wsArchivio, ultimaRiga, _
numeriFrequenti(i, 1), _
numeriFrequenti(i, 2), _
colGioco_Inizio, colGioco_Fine)
' Trova e formatta la data dell'ultimo esito
Dim ultimoEsito As ultimoEsito
ultimoEsito = TrovaUltimoEsito(wsArchivio, ultimaRiga, _
numeriFrequenti(i, 1), _
numeriFrequenti(i, 2), _
colGioco_Inizio, colGioco_Fine)
If ultimoEsito.Data <> 0 Then
.Cells(riga, 7).Value = "[" & ultimoEsito.Codice & "][" & ultimoEsito.Concorso & "]" & _
Format(ultimoEsito.Data, " dd.mm.yyyy")
.Cells(riga, 7).NumberFormat = "@" ' Formato testo per mantenere lo zero iniziale
Else
.Cells(riga, 7).Value = "in corso"
End If
.Cells(riga, 8).Value = Format2(numeriFrequenti(i, 4)) ' Ritardo serie
.Cells(riga, 9).Value = numeriFrequenti(i, 3) ' Presenza serie
.Cells(riga, 10).Value = Format2(numeriFrequenti(i, 5)) ' Ritardo Max
' Aggiunge le presenze singole e in posizioni
.Cells(riga, 11).Value = FormatPresenzePosizioni(numeriFrequenti(i, 1), _
numeriFrequenti(i, 2), _
presenzePosizioni)
' Formattazione riga
With .Range("A" & riga & ":K" & riga)
.Borders.LineStyle = xlContinuous
If i Mod 2 = 0 Then .Interior.Color = RGB(240, 240, 240)
.HorizontalAlignment = xlCenter
End With
' Allineamenti specifici
.Cells(riga, 5).HorizontalAlignment = xlLeft
.Cells(riga, 11).HorizontalAlignment = xlLeft
End With
riga = riga + 1
End If
Next i
' Footer
With wsDest.Cells(riga + 2, 1)
.Value = "********* Tabella List by Mike58 **********"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With wsDest.Cells(riga + 3, 1)
.Value = "Report generato il " & Format(Now, "dd/mm/yyyy hh:mm:ss")
.Font.Italic = True
End With
' Formattazione finale
wsDest.Columns("A:K").AutoFit
' Seleziona prima cella
wsDest.Range("A1").Select
End Sub
Questo è il suo output:
Vedi l'allegato 2292497
E questo, con gli stessi parametri, è quello dello Script Futuro2:
Vedi l'allegato 2292498
Come puoi vedere le differenze sono sostanziali. Le AI hanno molti limiti, che aumentano quando a porle le domande sono persone confuse come me. Poi prendono tutto alla lettera, quindi occorre fare molta attenzione alle parole usate per comunicare con loro.
Possono essere utili per compiti semplici per chi, come me, non ricorda ssolutamente nulla di Excel. Spesso dopo aperto, mi devo ridocumentare per capire, per un po', come fare cosa. Se fosse solo per me lo lascerei così, giusto o sbagliato che sia, ma visto che altri vorrebbero usarlo, non mi dispiacerebbe dar loro qualcosa di funzionante. Quindi grazie per l'interessamento.
Comunque se vuoi vedere il foglio si chiama Missione:
https://mega.nz/file/yM4wEbAY#alqfqVelLgxuq5j7zAYxpd6neBTIhajb6j9FIX8uY68
Saluti
Baciccia
Buon lavoro.
.
.
