Novità

regalino

genios

Advanced Member >PLATINUM<
Codice:
Sub Main()
    Dim ruota,pos,es,numero,ultimaEstrazione,estrazioneIniziale,estrazioneFinale
    Dim numeriRicerca(5),posizioni(5)
    Dim i,j,n,posIndex
    Dim conteggioNumeri(90),risultato(9,10)
    Dim valore
    Dim parole(150),colori(150),grassetti(150),indice,valoreReale
    Dim estratti(5),estrattiPrecedenti(5)
    Dim coloreRosso,coloreNero
    Dim coloraRossoPrecedenti(5),coloraRossoCorrenti(5)

    coloreRosso = vbRed
    coloreNero = vbBlack

    ruota = 5
    Scrivi "Ruota:(" & ruota & ")",True
    Scrivi

    ultimaEstrazione = EstrazioneFin()

    ' Intestazione allineata ai valori
    Scrivi "           0000000001 1111111112 2222222223 3333333334 4444444445 5555555556 6666666667 7777777778 8888888889",True
    Scrivi "           1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890",True
    Scrivi

    ' Inizializza estratti precedenti a zero
    For i = 1 To 5
        estrattiPrecedenti(i) = 0
    Next

    For k = 29 To 0 Step - 1
        estrazioneIniziale = ultimaEstrazione - k

        ' Recupera i numeri estratti per l'estrazione corrente
        For i = 1 To 5
            numeriRicerca(i) = Estratto(estrazioneIniziale,ruota,i)
        Next

        ' Salva gli estratti da visualizzare alla fine
        For i = 1 To 5
            estratti(i) = numeriRicerca(i)
        Next

        estrazioneFinale = estrazioneIniziale - 2900

        For n = 1 To 90
            conteggioNumeri(n) = 0
        Next

        ' Calcola il conteggio dei numeri nelle estrazioni
        For i = 1 To 5
            Dim contatoreOccorrenze
            contatoreOccorrenze = 0

            For es = estrazioneIniziale To estrazioneFinale Step - 1
                numero = Estratto(es,ruota,i)
                If numero = numeriRicerca(i) Then
                    contatoreOccorrenze = contatoreOccorrenze + 1

                    ' Calcolo per la decina della spia
                    Dim decinaSpia
                    decinaSpia = Int((numeriRicerca(i) - 1) / 10) ' Calcola la decina della spia

                    ' Verifica la posizione della spia
                    Dim posSpia
                    posSpia = i

                    ' Conta tutti i numeri appartenenti alla decina della spia nelle successive 12 estrazioni
                    For j = 1 To 12
                        If(es + j) <= estrazioneIniziale Then
                            For posIndex = 1 To 5
                                numero = Estratto(es + j,ruota,posIndex)
                                If numero > 0 And numero <= 90 Then
                                    ' Verifica se il numero appartiene alla stessa decina della spia
                                    If Int((numero - 1) / 10) = decinaSpia Then
                                        ' Controlla se la posizione è valida per la spia
                                        Dim posVerifica
                                        posVerifica =(posSpia + j - 1) Mod 5 + 1
                                        If posVerifica = posIndex Or posVerifica =((posIndex Mod 5) + 1) Then
                                            conteggioNumeri(numero) = conteggioNumeri(numero) + 1
                                        End If
                                    End If
                                End If
                            Next
                        End If
                    Next
                End If

                If contatoreOccorrenze >= 12 Then Exit For
            Next
        Next

        For i = 0 To 8
            For j = 1 To 10
                risultato(i,j) = conteggioNumeri(i * 10 + j)
            Next
        Next

        indice = 0
        parole(0) = DataEstrazione(estrazioneIniziale) & " " ' Aggiungi la data con uno spazio all'inizio
        colori(0) = coloreNero
        grassetti(0) = True
        indice = 1 ' Partiamo dall'indice 1 per i valori

        ' Ciclo per la creazione delle parole formattate e colorate
        For i = 0 To 8 ' Gruppi di 10 numeri
            For j = 1 To 10 ' Colonne
                valore = risultato(i,j)
                valoreReale = i * 10 + j ' Questo è il valore numerico che stiamo considerando (es. 1-90)

                If valore >= 10 Then
                    valore = Chr(65 +(valore - 10)) ' Converte valori >= 10 in A, B, etc.
                ElseIf valore = 0 Then
                    valore = "*" ' Sostituisce lo zero con un asterisco
                End If

                ' Gestione della colorazione tenendo conto degli spazi e dei valori alfanumerici
                If IsInArray(valoreReale,numeriRicerca) Then
                    colori(indice) = coloreRosso
                Else
                    colori(indice) = coloreNero
                End If

                ' Assicurati che valore sia corretto per la visualizzazione
                If IsNumeric(valore) Or valore = "*" Then
                    parole(indice) = FormatSpace(valore,0,False) ' Usa FormatSpace anche per *
                Else
                    parole(indice) = valore ' Aggiungi il valore letterale (A, B, C, ...)
                End If

                grassetti(indice) = True
                indice = indice + 1
            Next

            ' Aggiungi uno spazio ogni 10 numeri, ma senza spazio tra le presenze
            parole(indice) = " " ' Aggiungi lo spazio tra le decine
            colori(indice) = coloreNero
            grassetti(indice) = True
            indice = indice + 1
        Next

        ' Determina quali estratti colorare di rosso per l'estrazione corrente e precedente
        If k < 29 Then ' Solo se non è la prima iterazione
            For i = 1 To 5
                ' Verifica se la decina è la stessa nella stessa posizione estrazionale
                If Int((estratti(i) - 1) / 10) = Int((estrattiPrecedenti(i) - 1) / 10) Then
                    coloraRossoCorrenti(i) = True
                    coloraRossoPrecedenti(i) = True
                Else
                    coloraRossoCorrenti(i) = False
                    coloraRossoPrecedenti(i) = False
                End If
            Next
        End If

        ' Aggiungi gli estratti dell'estrazione corrente alla fine della riga con Format2 e separati da un punto
        For i = 1 To 5
            ' Colorazione per gli estratti dell'estrazione corrente
            If coloraRossoCorrenti(i) Then
                colori(indice) = coloreRosso
            Else
                colori(indice) = coloreNero
            End If

            parole(indice) = Format2(estratti(i)) & "."
            grassetti(indice) = True
            indice = indice + 1
        Next

        ' Memorizza i numeri correnti per la verifica nelle estrazioni successive
        For i = 1 To 5
            estrattiPrecedenti(i) = estratti(i)
        Next

        ' Stampa la riga con la data dell'estrazione, i valori colorati e gli estratti alla fine
        ScriviConColori parole,colori,grassetti
    Next
End Sub

Function IsInArray(valore,arr)
    Dim i
    IsInArray = False
    For i = LBound(arr) To UBound(arr)
        If arr(i) = valore Then
            IsInArray = True
            Exit Function
        End If
    Next
End Function
 
Ciao Genios
attirato dal tuo ottimo Script ho provato a far fare una macro per Excel all'AI. E, seppur ancora da correggere in qualche punto, non sembra male:

1731150780210.png

Vorrei inserirlo nel file che metto a disposizione del Forum, naturalmente se tu non hai nulla in contrario. Ho specificato nel foglio che lo Script l'hai fatto tu, io me ne sono solamente appropriato. Fammi sapere
Ciao
Baciccia
 
Ciao Baci visto che hai "capito" lo script puoi spiegarcelo, grazie.


CHI TACE ACCONSENTE HAHAHAHHAHA
Per fare quello che devi fare basta che tu faccia quello che devi fare. Nel caso non funzioni fai in un altro modo.
E' simile, ma non uguale a lotto7, ma per le spiegazioni attendiamo l'ottimo genius che ne sa decisamente più di me.
Ciao Alien
Baciccia
 
Per fare quello che devi fare basta che tu faccia quello che devi fare ACC........ non so cosa fare.....................hahahahha




e740ec10fcaab0ed6bc97fb9a1cffdeb.gif
 
Altro regalino Madam Tolot
Codice:
Option Explicit

Sub Main
'Madam Tolot
    ' Dichiarazione delle variabili
    Dim IdEstCorrente,IdEstSuccessivo
    Dim DataCorrente,EstrattiCorrente,DataSuccessiva,EstrattiSuccessiva
    Dim NumeroCorrente,NumeroSuccessivo
    Dim DecinaCorrente,UnitaCorrente,DecinaSuccessiva,UnitaSuccessiva
    Dim SommaDecine,SommaUnita
    Dim IdEstRicerca,Trovato,i
    Dim NumeriTrovati
Dim Ruota
Ruota=6
Scrivi " Ruota numero "&" "& Ruota
Scrivi
Scrivi
    ' Inizializziamo l'estrazione corrente
    IdEstCorrente = EstrazioneIni() ' Ottiene il primo ID valido dall'archivio

    Do While IdEstCorrente <= EstrazioneFin() - 1
        ' Imposta l'ID dell'estrazione successiva
        IdEstSuccessivo = IdEstCorrente + 1
        ' Verifica che l'ID successivo sia all'interno dell'intervallo valido
        If IdEstSuccessivo > EstrazioneFin() Then
            Scrivi "Errore: Numero estrazione successiva fuori dal range"
            Exit Do
        End If

        ' Ottieni la data e gli estratti dell'estrazione corrente
        DataCorrente = DataEstrazione(IdEstCorrente)
        EstrattiCorrente = StringaEstratti(IdEstCorrente,Ruota,".",0,0)

        ' Ottieni la data e gli estratti dell'estrazione successiva
        DataSuccessiva = DataEstrazione(IdEstSuccessivo)
        EstrattiSuccessiva = StringaEstratti(IdEstSuccessivo,Ruota,".",0,0)

        ' Otteniamo i numeri della prima posizione delle due estrazioni
        NumeroCorrente = Estratto(IdEstCorrente,Ruota,1,0) ' Prima posizione
        NumeroSuccessivo = Estratto(IdEstSuccessivo,Ruota,1,0) ' Prima posizione

        ' Calcolo delle decine e delle unità
        DecinaCorrente = NumeroCorrente \ 10
        UnitaCorrente = NumeroCorrente Mod 10
        DecinaSuccessiva = NumeroSuccessivo \ 10
        UnitaSuccessiva = NumeroSuccessivo Mod 10

        ' Somma delle decine e delle unità
        SommaDecine = DecinaCorrente + DecinaSuccessiva
        SommaUnita = UnitaCorrente + UnitaSuccessiva

        ' Stampa i risultati
        Scrivi "Data Estrazione:            " & DataCorrente
        Scrivi "ID Estrazione Corrente:      " & IdEstCorrente
        Scrivi "Numero in prima posizione: " & NumeroCorrente
        Scrivi
        Scrivi "Data Estrazione Successiva:   " & DataSuccessiva
        Scrivi "ID Estrazione Successiva:     " & IdEstSuccessivo
        Scrivi "Numero in prima posizione: " & NumeroSuccessivo
        Scrivi
        Scrivi "Somma delle decine: " & SommaDecine
        Scrivi "Somma delle unità: " & SommaUnita
        Scrivi

        ' Iniziamo la ricerca per i nuovi numeri
        IdEstRicerca = IdEstSuccessivo + 1
        Trovato = False
        NumeriTrovati = ""

        ' Cerca fino a trovare uno dei due numeri in tutte le posizioni
        Do While IdEstRicerca <= EstrazioneFin()
            For i = 1 To 5 ' Controlla tutte e cinque le posizioni
                If Estratto(IdEstRicerca,Ruota,i,0) = SommaDecine Then
                    NumeriTrovati = NumeriTrovati & SommaDecine & " "
                    Trovato = True
                ElseIf Estratto(IdEstRicerca,1,i,0) = SommaUnita Then
                    NumeriTrovati = NumeriTrovati & SommaUnita & " "
                    Trovato = True
                End If
            Next
            If Trovato Then Exit Do
            IdEstRicerca = IdEstRicerca + 1
        Loop

        ' Stampa i risultati della ricerca
        If Trovato Then
            Scrivi "Numero trovato dopo " &(IdEstRicerca - IdEstSuccessivo) & " estrazioni: ",False,True,- 1,255
            Scrivi Trim(NumeriTrovati)
        Else
            Scrivi "Nessun numero trovato dopo l'ID " & IdEstSuccessivo & "."
        End If
        Scrivi

        ' Incrementa l'ID dell'estrazione corrente di 9 per saltare alla prossima iterazione
        IdEstCorrente = IdEstCorrente + 9
    Loop
End Sub
 
Altro regalino Madam Tolot
Codice:
Option Explicit

Sub Main
'Madam Tolot
    ' Dichiarazione delle variabili
    Dim IdEstCorrente,IdEstSuccessivo
    Dim DataCorrente,EstrattiCorrente,DataSuccessiva,EstrattiSuccessiva
    Dim NumeroCorrente,NumeroSuccessivo
    Dim DecinaCorrente,UnitaCorrente,DecinaSuccessiva,UnitaSuccessiva
    Dim SommaDecine,SommaUnita
    Dim IdEstRicerca,Trovato,i
    Dim NumeriTrovati
Dim Ruota
Ruota=6
Scrivi " Ruota numero "&" "& Ruota
Scrivi
Scrivi
    ' Inizializziamo l'estrazione corrente
    IdEstCorrente = EstrazioneIni() ' Ottiene il primo ID valido dall'archivio

    Do While IdEstCorrente <= EstrazioneFin() - 1
        ' Imposta l'ID dell'estrazione successiva
        IdEstSuccessivo = IdEstCorrente + 1
        ' Verifica che l'ID successivo sia all'interno dell'intervallo valido
        If IdEstSuccessivo > EstrazioneFin() Then
            Scrivi "Errore: Numero estrazione successiva fuori dal range"
            Exit Do
        End If

        ' Ottieni la data e gli estratti dell'estrazione corrente
        DataCorrente = DataEstrazione(IdEstCorrente)
        EstrattiCorrente = StringaEstratti(IdEstCorrente,Ruota,".",0,0)

        ' Ottieni la data e gli estratti dell'estrazione successiva
        DataSuccessiva = DataEstrazione(IdEstSuccessivo)
        EstrattiSuccessiva = StringaEstratti(IdEstSuccessivo,Ruota,".",0,0)

        ' Otteniamo i numeri della prima posizione delle due estrazioni
        NumeroCorrente = Estratto(IdEstCorrente,Ruota,1,0) ' Prima posizione
        NumeroSuccessivo = Estratto(IdEstSuccessivo,Ruota,1,0) ' Prima posizione

        ' Calcolo delle decine e delle unità
        DecinaCorrente = NumeroCorrente \ 10
        UnitaCorrente = NumeroCorrente Mod 10
        DecinaSuccessiva = NumeroSuccessivo \ 10
        UnitaSuccessiva = NumeroSuccessivo Mod 10

        ' Somma delle decine e delle unità
        SommaDecine = DecinaCorrente + DecinaSuccessiva
        SommaUnita = UnitaCorrente + UnitaSuccessiva

        ' Stampa i risultati
        Scrivi "Data Estrazione:            " & DataCorrente
        Scrivi "ID Estrazione Corrente:      " & IdEstCorrente
        Scrivi "Numero in prima posizione: " & NumeroCorrente
        Scrivi
        Scrivi "Data Estrazione Successiva:   " & DataSuccessiva
        Scrivi "ID Estrazione Successiva:     " & IdEstSuccessivo
        Scrivi "Numero in prima posizione: " & NumeroSuccessivo
        Scrivi
        Scrivi "Somma delle decine: " & SommaDecine
        Scrivi "Somma delle unità: " & SommaUnita
        Scrivi

        ' Iniziamo la ricerca per i nuovi numeri
        IdEstRicerca = IdEstSuccessivo + 1
        Trovato = False
        NumeriTrovati = ""

        ' Cerca fino a trovare uno dei due numeri in tutte le posizioni
        Do While IdEstRicerca <= EstrazioneFin()
            For i = 1 To 5 ' Controlla tutte e cinque le posizioni
                If Estratto(IdEstRicerca,Ruota,i,0) = SommaDecine Then
                    NumeriTrovati = NumeriTrovati & SommaDecine & " "
                    Trovato = True
                ElseIf Estratto(IdEstRicerca,1,i,0) = SommaUnita Then
                    NumeriTrovati = NumeriTrovati & SommaUnita & " "
                    Trovato = True
                End If
            Next
            If Trovato Then Exit Do
            IdEstRicerca = IdEstRicerca + 1
        Loop

        ' Stampa i risultati della ricerca
        If Trovato Then
            Scrivi "Numero trovato dopo " &(IdEstRicerca - IdEstSuccessivo) & " estrazioni: ",False,True,- 1,255
            Scrivi Trim(NumeriTrovati)
        Else
            Scrivi "Nessun numero trovato dopo l'ID " & IdEstSuccessivo & "."
        End If
        Scrivi

        ' Incrementa l'ID dell'estrazione corrente di 9 per saltare alla prossima iterazione
        IdEstCorrente = IdEstCorrente + 9
    Loop
End Sub
Scusa genios è qualcosa del genere? 1732032612125.png
 
Scusa genios è qualcosa del genere? Vedi l'allegato 2293349
Se qualcuno è interessato questa è la macro, se sia corretta boh! Funziona.

Option Explicit

Sub MadamTolot()
' Dichiarazione delle variabili
Dim ws As Worksheet
Dim wsMdm As Worksheet
Dim IdEstCorrente As Long, IdEstSuccessivo As Long
Dim DataCorrente As Date, EstrattiCorrente As String
Dim DataSuccessiva As Date, EstrattiSuccessiva As String
Dim NumeroCorrente As Integer, NumeroSuccessivo As Integer
Dim DecinaCorrente As Integer, UnitaCorrente As Integer
Dim DecinaSuccessiva As Integer, UnitaSuccessiva As Integer
Dim SommaDecine As Integer, SommaUnita As Integer
Dim IdEstRicerca As Long, Trovato As Boolean, i As Integer
Dim NumeriTrovati As String
Dim Ruota As String
Dim colStart As Long, colEnd As Long
Dim riga As Long
Dim dataInizio As Date, dataFine As Date

' Variabili per la statistica
Dim entro9 As Integer, tra10e18 As Integer, oltre18 As Integer, mai As Integer
Dim riepilogoRiga As Long
Dim colpiMancanti As Long
Dim numeriInGioco As Collection

Set numeriInGioco = New Collection

' Imposta i fogli di lavoro
Set ws = ThisWorkbook.Sheets("Archivio")

' Crea o seleziona il foglio MdmTolot
On Error Resume Next
Set wsMdm = ThisWorkbook.Sheets("MdmTolot")
If wsMdm Is Nothing Then
Set wsMdm = ThisWorkbook.Sheets.Add
wsMdm.name = "MdmTolot"
End If
On Error GoTo 0

' Cancella i contenuti del foglio MdmTolot mantenendo i formati dalla colonna C in poi
wsMdm.Columns("A:B").Clear
wsMdm.Columns("C:Z").ClearContents
riga = 1

' Chiedi all'utente quale ruota analizzare
Ruota = UCase(InputBox("Inserisci la ruota da analizzare (Bari, Cagliari, ecc.):"))
If Ruota = "" Then Exit Sub

' Determina le colonne in base alla ruota
Select Case Ruota
Case "BARI": colStart = 4: colEnd = 8
Case "CAGLIARI": colStart = 9: colEnd = 13
Case "FIRENZE": colStart = 14: colEnd = 18
Case "GENOVA": colStart = 19: colEnd = 23
Case "MILANO": colStart = 24: colEnd = 28
Case "NAPOLI": colStart = 29: colEnd = 33
Case "PALERMO": colStart = 34: colEnd = 38
Case "ROMA": colStart = 39: colEnd = 43
Case "TORINO": colStart = 44: colEnd = 48
Case "VENEZIA": colStart = 49: colEnd = 53
Case "NAZIONALE": colStart = 54: colEnd = 58
Case Else
MsgBox "Ruota non valida"
Exit Sub
End Select

' Chiedi il periodo di ricerca basato sulle date
Dim inputDataInizio As String, inputDataFine As String
inputDataInizio = InputBox("Inserisci la data iniziale (gg/mm/aaaa):")
If inputDataInizio = "" Then Exit Sub
inputDataFine = InputBox("Inserisci la data finale (gg/mm/aaaa):")
If inputDataFine = "" Then Exit Sub

' Converti le date e verifica che siano valide
On Error GoTo DateError
dataInizio = CDate(inputDataInizio)
dataFine = CDate(inputDataFine)
On Error GoTo 0

' Assicurati che dataInizio non sia dopo dataFine
If dataInizio > dataFine Then
MsgBox "La data di inizio non può essere successiva alla data finale."
Exit Sub
End If

' Scrivi le informazioni di intestazione nel foglio MdmTolot
wsMdm.Cells(2, 5).Value = "Ruota Analizzata: " & Ruota
wsMdm.Cells(3, 5).Value = "Data Inizio: " & Format(dataInizio, "dd/mm/yyyy")
wsMdm.Cells(4, 5).Value = "Data Fine: " & Format(dataFine, "dd/mm/yyyy")

' Inizializziamo l'estrazione corrente
IdEstCorrente = 9 ' Prima riga dei dati

' Trova la riga di inizio e fine in base alle date
Do While ws.Cells(IdEstCorrente, 3).Value < dataInizio And IdEstCorrente <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
IdEstCorrente = IdEstCorrente + 1
Loop

Do While IdEstCorrente <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
If ws.Cells(IdEstCorrente, 3).Value > dataFine Then Exit Do

' Imposta l'ID dell'estrazione successiva
IdEstSuccessivo = IdEstCorrente + 1

' Ottieni la data e gli estratti dell'estrazione corrente
DataCorrente = ws.Cells(IdEstCorrente, 3).Value
NumeroCorrente = ws.Cells(IdEstCorrente, colStart).Value

' Ottieni la data e gli estratti dell'estrazione successiva
DataSuccessiva = ws.Cells(IdEstSuccessivo, 3).Value
NumeroSuccessivo = ws.Cells(IdEstSuccessivo, colStart).Value

' Calcolo delle decine e delle unità
DecinaCorrente = NumeroCorrente \ 10
UnitaCorrente = NumeroCorrente Mod 10
DecinaSuccessiva = NumeroSuccessivo \ 10
UnitaSuccessiva = NumeroSuccessivo Mod 10

' Somma delle decine e delle unità
SommaDecine = DecinaCorrente + DecinaSuccessiva
SommaUnita = UnitaCorrente + UnitaSuccessiva

' Stampa i risultati
Scrivi "Data Estrazione: " & Format(DataCorrente, "dd/mm/yyyy"), wsMdm, riga
riga = riga + 1
Scrivi "ID Estrazione Corrente: " & IdEstCorrente, wsMdm, riga
riga = riga + 1
Scrivi "Numero in prima posizione: " & NumeroCorrente, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

Scrivi "Data Estrazione Successiva: " & Format(DataSuccessiva, "dd/mm/yyyy"), wsMdm, riga
riga = riga + 1
Scrivi "ID Estrazione Successiva: " & IdEstSuccessivo, wsMdm, riga
riga = riga + 1
Scrivi "Numero in prima posizione: " & NumeroSuccessivo, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

Scrivi "Somma delle decine: " & SommaDecine, wsMdm, riga
riga = riga + 1
Scrivi "Somma delle unità: " & SommaUnita, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

' Iniziamo la ricerca per i nuovi numeri
IdEstRicerca = IdEstSuccessivo + 1
Trovato = False
NumeriTrovati = ""

' Cerca fino a trovare uno dei due numeri in tutte le posizioni
Do While IdEstRicerca <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
For i = colStart To colEnd
If ws.Cells(IdEstRicerca, i).Value = SommaDecine Then
NumeriTrovati = NumeriTrovati & SommaDecine & " "
Trovato = True
ElseIf ws.Cells(IdEstRicerca, i).Value = SommaUnita Then
NumeriTrovati = NumeriTrovati & SommaUnita & " "
Trovato = True
End If
Next i
If Trovato Then Exit Do
IdEstRicerca = IdEstRicerca + 1
Loop

' Stampa i risultati della ricerca e aggiorna le statistiche
If Trovato Then
Dim estrazioniTrascorse As Long
estrazioniTrascorse = IdEstRicerca - IdEstSuccessivo
Scrivi "Numero trovato dopo " & estrazioniTrascorse & " estrazioni: " & Trim(NumeriTrovati), wsMdm, riga, True

Select Case estrazioniTrascorse
Case Is <= 9
entro9 = entro9 + 1
Case 10 To 18
tra10e18 = tra10e18 + 1
Case Else
oltre18 = oltre18 + 1
End Select
Else
' Calcola quanti colpi mancano per arrivare a 18
colpiMancanti = 18 - (IdEstRicerca - IdEstSuccessivo)
Scrivi "Nessun numero trovato dopo l'ID " & IdEstSuccessivo & ". Mancano " & colpiMancanti & " colpi per arrivare a 18.", wsMdm, riga, False, True
mai = mai + 1

' Calcola il ritardo e frequenza per entrambi i numeri
Dim ritardoDecine As Long, ritardoUnita As Long
Dim frequenzaDecine As Long, frequenzaUnita As Long

ritardoDecine = CalcolaRitardo(ws, IdEstCorrente, SommaDecine, colStart, colEnd)
ritardoUnita = CalcolaRitardo(ws, IdEstCorrente, SommaUnita, colStart, colEnd)
frequenzaDecine = CalcolaFrequenza(ws, dataInizio, dataFine, SommaDecine, colStart, colEnd)
frequenzaUnita = CalcolaFrequenza(ws, dataInizio, dataFine, SommaUnita, colStart, colEnd)

' Aggiungi al riepilogo dei numeri ancora in gioco
numeriInGioco.Add "Somma Decine: " & SommaDecine & " - ID " & IdEstSuccessivo & " - Mancano " & colpiMancanti & _
" colpi - Ritardo: " & ritardoDecine & " - Frequenza: " & frequenzaDecine
numeriInGioco.Add "Somma Unità: " & SommaUnita & " - ID " & IdEstSuccessivo & " - Mancano " & colpiMancanti & _
" colpi - Ritardo: " & ritardoUnita & " - Frequenza: " & frequenzaUnita
End If
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

' Incrementa l'ID dell'estrazione corrente di 9
IdEstCorrente = IdEstCorrente + 9
Loop

' Scrivi la statistica finale a partire da E6
wsMdm.Cells(6, 5).Value = "Statistiche finali:"
wsMdm.Cells(7, 5).Value = "Entro 9 estrazioni: " & entro9
wsMdm.Cells(8, 5).Value = "Tra 10 e 18 estrazioni: " & tra10e18
wsMdm.Cells(9, 5).Value = "Oltre 18 estrazioni: " & oltre18
wsMdm.Cells(10, 5).Value = "Mai trovati: " & mai

' Scrivi il riepilogo dei numeri ancora in gioco a partire da E13
riepilogoRiga = 13
wsMdm.Cells(riepilogoRiga, 5).Value = "Riepilogo numeri ancora in gioco:"
riepilogoRiga = riepilogoRiga + 1
Dim numero As Variant
For Each numero In numeriInGioco
wsMdm.Cells(riepilogoRiga, 5).Value = numero
riepilogoRiga = riepilogoRiga + 1
Next numero

Exit Sub

DateError:
MsgBox "Errore nel formato delle date. Assicurati di usare il formato gg/mm/aaaa."
End Sub

Function CalcolaRitardo(ws As Worksheet, startRow As Long, numero As Integer, colStart As Long, colEnd As Long) As Long
Dim i As Long, delay As Long
delay = 0
For i = startRow To ws.Cells(ws.Rows.count, "C").End(xlUp).row
Dim j As Long
For j = colStart To colEnd
If ws.Cells(i, j).Value = numero Then
CalcolaRitardo = delay
Exit Function
End If
Next j
delay = delay + 1
Next i
CalcolaRitardo = delay
End Function

Function CalcolaFrequenza(ws As Worksheet, dataInizio As Date, dataFine As Date, numero As Integer, colStart As Long, colEnd As Long) As Long
Dim i As Long, count As Long
count = 0
For i = 9 To ws.Cells(ws.Rows.count, "C").End(xlUp).row
If ws.Cells(i, 3).Value >= dataInizio And ws.Cells(i, 3).Value <= dataFine Then
Dim j As Long
For j = colStart To colEnd
If ws.Cells(i, j).Value = numero Then
count = count + 1
End If
Next j
End If
Next i
CalcolaFrequenza = count
End Function

Sub Scrivi(ByVal testo As String, ByVal ws As Worksheet, ByVal riga As Long, Optional Evidenzia As Boolean = False, Optional EvidenziaMancanti As Boolean = False)
With ws.Cells(riga, 1)
.Value = testo
If Evidenzia Then
.Font.Color = RGB(255, 0, 0) ' Evidenzia in rosso
End If

' Evidenzia in giallo e grassetto se non sono stati trovati numeri
If EvidenziaMancanti Then
.Interior.Color = RGB(255, 255, 0) ' Sfondo giallo
.Font.Bold = True
End If

' Alterna i colori dello sfondo
If riga Mod 28 >= 1 And riga Mod 28 <= 13 Then
.Interior.Color = RGB(230, 230, 250) ' Lavanda chiaro
ElseIf riga Mod 28 >= 15 And riga Mod 28 <= 27 Then
.Interior.Color = RGB(255, 240, 245) ' Rosa pallido
End If

' Se è una riga vuota, nessun colore di sfondo
If testo = "" Then
.Interior.colorIndex = xlNone
End If

' Se è una statistica finale, usa un colore diverso
If InStr(1, testo, "Statistiche finali:") > 0 Then
.Interior.Color = RGB(255, 255, 200) ' Giallo chiaro
.Font.Bold = True
ElseIf InStr(1, testo, "Entro 9 estrazioni:") > 0 Or _
InStr(1, testo, "Tra 10 e 18 estrazioni:") > 0 Or _
InStr(1, testo, "Oltre 18 estrazioni:") > 0 Or _
InStr(1, testo, "Mai trovati:") > 0 Or _
InStr(1, testo, "Riepilogo numeri ancora in gioco:") > 0 Then
.Interior.Color = RGB(255, 255, 200) ' Giallo chiaro
End If
End With
End Sub
 
Regalino
Codice:
Option Explicit
Sub Main
 ' Dichiarazione delle variabili
Dim R, R1, Y

' Assegnazione della costante di decadimento
R1 = 17.495237

' Ciclo per calcolare Y per ogni valore di R da 1 a 260
For R = 1 To 260
    ' Calcolo di Y
    Y = Exp(-(R - 1) / R1)
    
    ' Stampa del risultato
   Scrivi"R: " & R & " -> Y: " & FormatNumber(Y, 6)
Next
 
End Sub
 
Se qualcuno è interessato questa è la macro, se sia corretta boh! Funziona.

Option Explicit

Sub MadamTolot()
' Dichiarazione delle variabili
Dim ws As Worksheet
Dim wsMdm As Worksheet
Dim IdEstCorrente As Long, IdEstSuccessivo As Long
Dim DataCorrente As Date, EstrattiCorrente As String
Dim DataSuccessiva As Date, EstrattiSuccessiva As String
Dim NumeroCorrente As Integer, NumeroSuccessivo As Integer
Dim DecinaCorrente As Integer, UnitaCorrente As Integer
Dim DecinaSuccessiva As Integer, UnitaSuccessiva As Integer
Dim SommaDecine As Integer, SommaUnita As Integer
Dim IdEstRicerca As Long, Trovato As Boolean, i As Integer
Dim NumeriTrovati As String
Dim Ruota As String
Dim colStart As Long, colEnd As Long
Dim riga As Long
Dim dataInizio As Date, dataFine As Date

' Variabili per la statistica
Dim entro9 As Integer, tra10e18 As Integer, oltre18 As Integer, mai As Integer
Dim riepilogoRiga As Long
Dim colpiMancanti As Long
Dim numeriInGioco As Collection

Set numeriInGioco = New Collection

' Imposta i fogli di lavoro
Set ws = ThisWorkbook.Sheets("Archivio")

' Crea o seleziona il foglio MdmTolot
On Error Resume Next
Set wsMdm = ThisWorkbook.Sheets("MdmTolot")
If wsMdm Is Nothing Then
Set wsMdm = ThisWorkbook.Sheets.Add
wsMdm.name = "MdmTolot"
End If
On Error GoTo 0

' Cancella i contenuti del foglio MdmTolot mantenendo i formati dalla colonna C in poi
wsMdm.Columns("A:B").Clear
wsMdm.Columns("C:Z").ClearContents
riga = 1

' Chiedi all'utente quale ruota analizzare
Ruota = UCase(InputBox("Inserisci la ruota da analizzare (Bari, Cagliari, ecc.):"))
If Ruota = "" Then Exit Sub

' Determina le colonne in base alla ruota
Select Case Ruota
Case "BARI": colStart = 4: colEnd = 8
Case "CAGLIARI": colStart = 9: colEnd = 13
Case "FIRENZE": colStart = 14: colEnd = 18
Case "GENOVA": colStart = 19: colEnd = 23
Case "MILANO": colStart = 24: colEnd = 28
Case "NAPOLI": colStart = 29: colEnd = 33
Case "PALERMO": colStart = 34: colEnd = 38
Case "ROMA": colStart = 39: colEnd = 43
Case "TORINO": colStart = 44: colEnd = 48
Case "VENEZIA": colStart = 49: colEnd = 53
Case "NAZIONALE": colStart = 54: colEnd = 58
Case Else
MsgBox "Ruota non valida"
Exit Sub
End Select

' Chiedi il periodo di ricerca basato sulle date
Dim inputDataInizio As String, inputDataFine As String
inputDataInizio = InputBox("Inserisci la data iniziale (gg/mm/aaaa):")
If inputDataInizio = "" Then Exit Sub
inputDataFine = InputBox("Inserisci la data finale (gg/mm/aaaa):")
If inputDataFine = "" Then Exit Sub

' Converti le date e verifica che siano valide
On Error GoTo DateError
dataInizio = CDate(inputDataInizio)
dataFine = CDate(inputDataFine)
On Error GoTo 0

' Assicurati che dataInizio non sia dopo dataFine
If dataInizio > dataFine Then
MsgBox "La data di inizio non può essere successiva alla data finale."
Exit Sub
End If

' Scrivi le informazioni di intestazione nel foglio MdmTolot
wsMdm.Cells(2, 5).Value = "Ruota Analizzata: " & Ruota
wsMdm.Cells(3, 5).Value = "Data Inizio: " & Format(dataInizio, "dd/mm/yyyy")
wsMdm.Cells(4, 5).Value = "Data Fine: " & Format(dataFine, "dd/mm/yyyy")

' Inizializziamo l'estrazione corrente
IdEstCorrente = 9 ' Prima riga dei dati

' Trova la riga di inizio e fine in base alle date
Do While ws.Cells(IdEstCorrente, 3).Value < dataInizio And IdEstCorrente <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
IdEstCorrente = IdEstCorrente + 1
Loop

Do While IdEstCorrente <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
If ws.Cells(IdEstCorrente, 3).Value > dataFine Then Exit Do

' Imposta l'ID dell'estrazione successiva
IdEstSuccessivo = IdEstCorrente + 1

' Ottieni la data e gli estratti dell'estrazione corrente
DataCorrente = ws.Cells(IdEstCorrente, 3).Value
NumeroCorrente = ws.Cells(IdEstCorrente, colStart).Value

' Ottieni la data e gli estratti dell'estrazione successiva
DataSuccessiva = ws.Cells(IdEstSuccessivo, 3).Value
NumeroSuccessivo = ws.Cells(IdEstSuccessivo, colStart).Value

' Calcolo delle decine e delle unità
DecinaCorrente = NumeroCorrente \ 10
UnitaCorrente = NumeroCorrente Mod 10
DecinaSuccessiva = NumeroSuccessivo \ 10
UnitaSuccessiva = NumeroSuccessivo Mod 10

' Somma delle decine e delle unità
SommaDecine = DecinaCorrente + DecinaSuccessiva
SommaUnita = UnitaCorrente + UnitaSuccessiva

' Stampa i risultati
Scrivi "Data Estrazione: " & Format(DataCorrente, "dd/mm/yyyy"), wsMdm, riga
riga = riga + 1
Scrivi "ID Estrazione Corrente: " & IdEstCorrente, wsMdm, riga
riga = riga + 1
Scrivi "Numero in prima posizione: " & NumeroCorrente, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

Scrivi "Data Estrazione Successiva: " & Format(DataSuccessiva, "dd/mm/yyyy"), wsMdm, riga
riga = riga + 1
Scrivi "ID Estrazione Successiva: " & IdEstSuccessivo, wsMdm, riga
riga = riga + 1
Scrivi "Numero in prima posizione: " & NumeroSuccessivo, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

Scrivi "Somma delle decine: " & SommaDecine, wsMdm, riga
riga = riga + 1
Scrivi "Somma delle unità: " & SommaUnita, wsMdm, riga
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

' Iniziamo la ricerca per i nuovi numeri
IdEstRicerca = IdEstSuccessivo + 1
Trovato = False
NumeriTrovati = ""

' Cerca fino a trovare uno dei due numeri in tutte le posizioni
Do While IdEstRicerca <= ws.Cells(ws.Rows.count, "C").End(xlUp).row
For i = colStart To colEnd
If ws.Cells(IdEstRicerca, i).Value = SommaDecine Then
NumeriTrovati = NumeriTrovati & SommaDecine & " "
Trovato = True
ElseIf ws.Cells(IdEstRicerca, i).Value = SommaUnita Then
NumeriTrovati = NumeriTrovati & SommaUnita & " "
Trovato = True
End If
Next i
If Trovato Then Exit Do
IdEstRicerca = IdEstRicerca + 1
Loop

' Stampa i risultati della ricerca e aggiorna le statistiche
If Trovato Then
Dim estrazioniTrascorse As Long
estrazioniTrascorse = IdEstRicerca - IdEstSuccessivo
Scrivi "Numero trovato dopo " & estrazioniTrascorse & " estrazioni: " & Trim(NumeriTrovati), wsMdm, riga, True

Select Case estrazioniTrascorse
Case Is <= 9
entro9 = entro9 + 1
Case 10 To 18
tra10e18 = tra10e18 + 1
Case Else
oltre18 = oltre18 + 1
End Select
Else
' Calcola quanti colpi mancano per arrivare a 18
colpiMancanti = 18 - (IdEstRicerca - IdEstSuccessivo)
Scrivi "Nessun numero trovato dopo l'ID " & IdEstSuccessivo & ". Mancano " & colpiMancanti & " colpi per arrivare a 18.", wsMdm, riga, False, True
mai = mai + 1

' Calcola il ritardo e frequenza per entrambi i numeri
Dim ritardoDecine As Long, ritardoUnita As Long
Dim frequenzaDecine As Long, frequenzaUnita As Long

ritardoDecine = CalcolaRitardo(ws, IdEstCorrente, SommaDecine, colStart, colEnd)
ritardoUnita = CalcolaRitardo(ws, IdEstCorrente, SommaUnita, colStart, colEnd)
frequenzaDecine = CalcolaFrequenza(ws, dataInizio, dataFine, SommaDecine, colStart, colEnd)
frequenzaUnita = CalcolaFrequenza(ws, dataInizio, dataFine, SommaUnita, colStart, colEnd)

' Aggiungi al riepilogo dei numeri ancora in gioco
numeriInGioco.Add "Somma Decine: " & SommaDecine & " - ID " & IdEstSuccessivo & " - Mancano " & colpiMancanti & _
" colpi - Ritardo: " & ritardoDecine & " - Frequenza: " & frequenzaDecine
numeriInGioco.Add "Somma Unità: " & SommaUnita & " - ID " & IdEstSuccessivo & " - Mancano " & colpiMancanti & _
" colpi - Ritardo: " & ritardoUnita & " - Frequenza: " & frequenzaUnita
End If
riga = riga + 1
Scrivi "", wsMdm, riga
riga = riga + 1

' Incrementa l'ID dell'estrazione corrente di 9
IdEstCorrente = IdEstCorrente + 9
Loop

' Scrivi la statistica finale a partire da E6
wsMdm.Cells(6, 5).Value = "Statistiche finali:"
wsMdm.Cells(7, 5).Value = "Entro 9 estrazioni: " & entro9
wsMdm.Cells(8, 5).Value = "Tra 10 e 18 estrazioni: " & tra10e18
wsMdm.Cells(9, 5).Value = "Oltre 18 estrazioni: " & oltre18
wsMdm.Cells(10, 5).Value = "Mai trovati: " & mai

' Scrivi il riepilogo dei numeri ancora in gioco a partire da E13
riepilogoRiga = 13
wsMdm.Cells(riepilogoRiga, 5).Value = "Riepilogo numeri ancora in gioco:"
riepilogoRiga = riepilogoRiga + 1
Dim numero As Variant
For Each numero In numeriInGioco
wsMdm.Cells(riepilogoRiga, 5).Value = numero
riepilogoRiga = riepilogoRiga + 1
Next numero

Exit Sub

DateError:
MsgBox "Errore nel formato delle date. Assicurati di usare il formato gg/mm/aaaa."
End Sub

Function CalcolaRitardo(ws As Worksheet, startRow As Long, numero As Integer, colStart As Long, colEnd As Long) As Long
Dim i As Long, delay As Long
delay = 0
For i = startRow To ws.Cells(ws.Rows.count, "C").End(xlUp).row
Dim j As Long
For j = colStart To colEnd
If ws.Cells(i, j).Value = numero Then
CalcolaRitardo = delay
Exit Function
End If
Next j
delay = delay + 1
Next i
CalcolaRitardo = delay
End Function

Function CalcolaFrequenza(ws As Worksheet, dataInizio As Date, dataFine As Date, numero As Integer, colStart As Long, colEnd As Long) As Long
Dim i As Long, count As Long
count = 0
For i = 9 To ws.Cells(ws.Rows.count, "C").End(xlUp).row
If ws.Cells(i, 3).Value >= dataInizio And ws.Cells(i, 3).Value <= dataFine Then
Dim j As Long
For j = colStart To colEnd
If ws.Cells(i, j).Value = numero Then
count = count + 1
End If
Next j
End If
Next i
CalcolaFrequenza = count
End Function

Sub Scrivi(ByVal testo As String, ByVal ws As Worksheet, ByVal riga As Long, Optional Evidenzia As Boolean = False, Optional EvidenziaMancanti As Boolean = False)
With ws.Cells(riga, 1)
.Value = testo
If Evidenzia Then
.Font.Color = RGB(255, 0, 0) ' Evidenzia in rosso
End If

' Evidenzia in giallo e grassetto se non sono stati trovati numeri
If EvidenziaMancanti Then
.Interior.Color = RGB(255, 255, 0) ' Sfondo giallo
.Font.Bold = True
End If

' Alterna i colori dello sfondo
If riga Mod 28 >= 1 And riga Mod 28 <= 13 Then
.Interior.Color = RGB(230, 230, 250) ' Lavanda chiaro
ElseIf riga Mod 28 >= 15 And riga Mod 28 <= 27 Then
.Interior.Color = RGB(255, 240, 245) ' Rosa pallido
End If

' Se è una riga vuota, nessun colore di sfondo
If testo = "" Then
.Interior.colorIndex = xlNone
End If

' Se è una statistica finale, usa un colore diverso
If InStr(1, testo, "Statistiche finali:") > 0 Then
.Interior.Color = RGB(255, 255, 200) ' Giallo chiaro
.Font.Bold = True
ElseIf InStr(1, testo, "Entro 9 estrazioni:") > 0 Or _
InStr(1, testo, "Tra 10 e 18 estrazioni:") > 0 Or _
InStr(1, testo, "Oltre 18 estrazioni:") > 0 Or _
InStr(1, testo, "Mai trovati:") > 0 Or _
InStr(1, testo, "Riepilogo numeri ancora in gioco:") > 0 Then
.Interior.Color = RGB(255, 255, 200) ' Giallo chiaro
End If
End With
End Sub
Ciao Baci nella tua "pergamena" di script mi da errore ma è per spaziometria ?


Sub MadamTolot()
' Dichiarazione delle variabili
Dim ws As Worksheet
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 21 dicembre 2024
    Bari
    19
    41
    16
    20
    75
    Cagliari
    46
    61
    09
    35
    37
    Firenze
    74
    33
    69
    80
    30
    Genova
    74
    16
    18
    88
    52
    Milano
    25
    78
    10
    72
    77
    Napoli
    70
    87
    83
    34
    89
    Palermo
    12
    81
    47
    31
    60
    Roma
    45
    42
    89
    08
    40
    Torino
    74
    73
    56
    70
    85
    Venezia
    05
    31
    35
    33
    21
    Nazionale
    39
    19
    83
    06
    68
    Estrazione Simbolotto
    Venezia
    21
    44
    08
    30
    04
Indietro
Alto