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
    martedì 13 ottobre 2026
    Bari
    56
    21
    79
    19
    67
    Cagliari
    23
    76
    52
    15
    63
    Firenze
    22
    63
    81
    76
    49
    Genova
    17
    57
    79
    14
    68
    Milano
    01
    03
    46
    32
    29
    Napoli
    69
    23
    30
    80
    10
    Palermo
    76
    84
    49
    87
    82
    Roma
    20
    06
    36
    62
    18
    Torino
    41
    55
    33
    08
    87
    Venezia
    39
    06
    81
    41
    79
    Nazionale
    52
    33
    59
    45
    12
    Estrazione Simbolotto
    37
    33
    13
    19
    08

Ultimi Messaggi

Indietro
Alto