Novità

Modifica Listato

Xeroxs

Advanced Member >PLATINUM<
Un Mio amico Mi ha passato questo listato è di qualche tempo fa ma non conosco le origini è stato creato per Lottodesk
Chiedevo se qualcuno può modificarlo per Spaziometria per testarne la sua efficacia statistica, certamente potrà essere utile a Tutti.
Io non riesco a modificarlo

Grazie comunque Fin da ora
Questo è il listato


Sub Main()
Dim frequenze(450,3)
Dim ruota
Dim p
Scrivi "Listato per gli estratti Flavio mod by Vasco"
Scrivi
'Mese di ricerca
ms = Mese(EstrazioneFin)
msr = InputBox("Mese di ricerca 1=gen, 2=feb... 12=Dic, 0 = tutti",,ms)
If msr > 0 Then
period = "ciclica per il mese di " & MeseNome(msr)
Else
period = "ciclo continuo"
End If
'ruota per la statistica
'ruota= InputBox("Ruota di ricerca",, 1)
Scrivi "============================================================="
Scrivi " Statistica dal " & DataEstrazione(estrazioneni) & " al " & DataEstrazione(EstrazioneFin) & " " & period
Scrivi "============================================================="
Scrivi
ruota = 0
Do While Not ruota = 10
ruota = ruota + 1
Erase frequenze
For i = 1 To 450
frequenze(i,2) = 0
Next
Scrivi "===================="
Scrivi" Ruota di " & NomeRuota(ruota)
Scrivi "===================="
For n = EstrazioneIni To EstrazioneFin
If msr > 0 Then
If Mese(n) = Mese(msr) Then
For p = 1 To 5
e = Estratto(n,ruota,p)
frequenze(e +(p - 1)*90,2) = frequenze(e +(p - 1)*90,2) + 1
Next
End If
Else
For p = 1 To 5
e = Estratto(n,ruota,p)
frequenze(e +(p - 1)*90,2) = frequenze(e +(p - 1)*90,2) + 1
Next
End If
Next
For i = 1 To 90
For p = 1 To 5
frequenze(i +(p - 1)*90,1) = i
frequenze(i +(p - 1)*90,3) = p
Next
Next
OrdinaMatrice frequenze,- 1,2
Scrivi " Num. Freq Pos."
ScriviMatrice frequenze,0,5
Loop
End Sub
 
Ciao a Tutti.

Devi togliere
'Erase frequenze
Però non so se è indispensabile e con cosa puoi sostituirlo, comunque togliendolo lo script funziona
 
Ciao a Tutti, x Salvo50 su LD lo script mi dà errore nella riga dove c'è la manina col pollice verso sai come dovrei fare x recuperare l'errore?Schermata 2020-04-28 alle 10.10.11.png
 
Buongiorno , credo che il listato possa essere corretto
sostituendo la riga
Dim frequenze(450,3)
con
Dim frequenze

e la riga
Erase frequenze
con
ReDim frequenze(450,3)
 
Non so se il msg. di Giggio era rivolto a me o a Xeroxs in ogni caso con LD la modifica al listato non funziona
 
buongiorno , la manina è un 'emoticon .. in realta il plaintext è ( n ) quindi al posto della manina va messo ( n )
io ho provato con il programma spaziometria.
 
Quello che ha scritto giggio è giusto.

Più precisamente le dim e gli erase ... per le frequenze...

Bisogna sostituirli TUTTI con Redim Frequenze (450,3)

:)
 
Ultima modifica:
SCUSATE A ME DA ERRORE QUA: SU IF MESE

Scrivi "===================="
Scrivi" Ruota di " & NomeRuota(ruota)
Scrivi "===================="
For n = EstrazioneIni To EstrazioneFin
If msr > 0 Then
If Mese
= Mese(msr) Then
For p = 1 To 5
e = Estratto(n,ruota,p)
frequenze(e +(p - 1)*90,2) = frequenze(e +(p - 1)*90,2) + 1
Next
End If
Else
For p = 1 To 5
e = Estratto(n,ruota,p
 
Alien, non è vero.

Lo script presente al primo messaggio gira su Spaziometria senza problemi.

Anche con tutto l'archivio di oltre 9700 estrazioni.

Che poi sia utile e/o i risultati prodotti,

siano almeno aderenti la realtà è cosa che non so e non intendo verificare.

Codice:
Sub Main()
   ReDim frequenze(450,3)
   Dim ruota
   Dim p
   Scrivi "Listato per gli estratti Flavio mod by Vasco"
   Scrivi
   'Mese di ricerca
   ms = Mese(EstrazioneFin)
   msr = InputBox("Mese di ricerca 1=gen, 2=feb... 12=Dic, 0 = tutti",,ms)
   If msr > 0 Then
      period = "ciclica per il mese di " & MeseNome(msr)
   Else
      period = "ciclo continuo"
   End If
   'ruota per la statistica
   'ruota= InputBox("Ruota di ricerca",, 1)
   Scrivi "============================================================="
   Scrivi " Statistica dal " & DataEstrazione(estrazioneni) & " al " & DataEstrazione(EstrazioneFin) & " " & period
   Scrivi "============================================================="
   Scrivi
   ruota = 0
   Do While Not ruota = 10
      ruota = ruota + 1
      ReDim frequenze(450,3)
      For i = 1 To 450
         frequenze(i,2) = 0
      Next
      Scrivi "===================="
      Scrivi" Ruota di " & NomeRuota(ruota)
      Scrivi "===================="
      For n = EstrazioneIni To EstrazioneFin
         If msr > 0 Then
            If Mese(n) = Mese(msr) Then
               For p = 1 To 5
                  e = Estratto(n,ruota,p)
                  frequenze(e +(p - 1)*90,2) = frequenze(e +(p - 1)*90,2) + 1
               Next
            End If
         Else
            For p = 1 To 5
               e = Estratto(n,ruota,p)
               frequenze(e +(p - 1)*90,2) = frequenze(e +(p - 1)*90,2) + 1
            Next
         End If
      Next
      For i = 1 To 90
         For p = 1 To 5
            frequenze(i +(p - 1)*90,1) = i
            frequenze(i +(p - 1)*90,3) = p
         Next
      Next
      OrdinaMatrice frequenze,- 1,2
      Scrivi " Num. Freq Pos."
      ScriviMatrice frequenze,0,5
   Loop
End Sub

:)
 
E' perfetto adesso funziona ma è solo una statistica cosa si può dedurre per fare un pronostico, oppure e solo visivo.
 
Ciao, Il File che mi aveva fatto vedere il mio amico su immagine lottodesk dava informazioni più complete, se possibile vedo di recuperare il tutto, così da come si mostra offre poco per una statistica mensile che è cio che cercavo, se troveò qualcosa lo posterò.
Grazie comunque per l'aiuto.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 21 febbraio 2026
    Bari
    72
    63
    35
    12
    01
    Cagliari
    02
    31
    01
    53
    10
    Firenze
    30
    35
    05
    87
    42
    Genova
    74
    32
    43
    68
    80
    Milano
    39
    06
    64
    16
    83
    Napoli
    56
    65
    71
    07
    12
    Palermo
    11
    57
    50
    28
    71
    Roma
    35
    23
    58
    89
    46
    Torino
    27
    28
    74
    16
    75
    Venezia
    68
    70
    27
    77
    83
    Nazionale
    28
    52
    18
    26
    39
    Estrazione Simbolotto
    Cagliari
    42
    15
    21
    19
    13

Ultimi Messaggi

Indietro
Alto