keeper
Advanced Member >PLATINUM PLUS<
posto lo script nato da una mia intuizione e come sempre sviluppato da rubino che al 10elotto serale e 5 minuti che permette di selezionare una quantità mdi numeri al di sotto della soglia di ricerca della frequenza relativaal totale delle estrazioni presenti in archivio o di un numero di estrazioni scelte dall'utente.
una volta rintracciati questi numeri si possono inserire un un tuo script che mi hai realizzato e che mi permette di rintracciare in determinate fasce di orari le migliori combinazioni. posto anche il secondo script.
1 script frequenza relativa
l'insieme di questi due script permette di restringere molto la ricerca dei numeri e di aumentare la possibilità di centrare la vincita
una volta rintracciati questi numeri si possono inserire un un tuo script che mi hai realizzato e che mi permette di rintracciare in determinate fasce di orari le migliori combinazioni. posto anche il secondo script.
1 script frequenza relativa
Codice:
Sub Main() ''''metodo 10 e lotto frequenza dei 90 numeri
'-------------------------------------------------------------------------------------------------------------------------------
Dim nm(20)
Dim fre(90)
Dim Totest,tq,kk,di
nf = CInt(InputBox("Archivio 10eLotto = 1 1oeLotto5m = 2 ",,1))
lim = InputBox("Evidenzia Numeri con Frequenza media < 4.5 (metti virgola) ",,"4,5")
If nf = 2 Then
rt = InputBox("Quante estrazioni prima dell'ultima in archivio? ",,8000)
End If
ImpostaArchivio10ELotto(nf)
If nf = 1 Then
fin = EstrazioniArchivioDL
Ini = 8075
Else
fin = EstrazioniArchivioDL
Ini = EstrazioniArchivioDL - Int(rt)
End If
If nf = 1 Then Scrivi " Calcolo Media Sortite dei 90 numeri al 10eLOTTO Serale"
If nf = 2 Then Scrivi " Calcolo Media Sortite dei 90 numeri al 10eLOTTO 5 Minuti"
Scrivi " Dall'estrazione n. al n. " & Ini & " - " & fin
Totest = fin - Ini
For Ini = Ini + 1 To fin
idestr = Ini
'''carica schiera con 20 numeri estratti x calcolo frequenza
For h = 1 To 20
di = EstrattoDL(idestr,h)
fre(di) = fre(di) + 1
Next
Next
Scrivi Totest & "-" & Ini & "-" & fin
For kk = 1 To 90
tq = Totest / fre(kk)
Scrivi " nr. " & Format2(kk) & " media = " & Round(tq,3) & " uscite " & Format2(fre(kk))
If Round(tq,1) < Round(lim,1) Then
riepil = riepil & Format2(kk) & " "
End If
Next
ColoreTesto(2)
Scrivi " Riepilogo numeri con freq.media < " & lim,1
Scrivi riepil
End Sub
[COLOR=#ff0000]2 script la ventina, qui lo script è limitato a venti numeri. va bene tale restrizione occorre sono modificare la parte per il 10 e lotto serale in quanto non ha le fasce di orario[/COLOR]
Option Explicit
Dim collPresenze
Class clsFormazione
Public nFre
Public nRit
Public nRitMax
Public aNumeri(90)
Private Sub Class_Initialize
Dim k
For k = 1 To 90
aNumeri(k) = False
Next
nFre = 0
nRit = 0
nRitMax = 0
End Sub
Function GetNumeri
Dim k,s
s = ""
For k = 1 To 90
If aNumeri(k) Then s = s & Format2(k) & "."
Next
If s <> "" Then s = Left(s,Len(s) - 1)
GetNumeri = s
End Function
End Class
Sub Main
Dim nEstrInizio,nEstrFine
Dim DataIni,DataFin
Dim FasciaOrariaIni,FasciaOrariaFin
Dim sOraIni,sOraFin
Dim quantitaFrz
Dim nClasse
Dim nSorte
Dim nEstrEsam,nEstrValide,nEstrNonValide
Call ImpostaArchivio10ELotto(2)
ReDim aNumBase(0)
If ChiediNumeri(aNumBase) Then
If ChiediDataInizioFine(DataIni,DataFin,10) Then
If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin,sOraIni,sOraFin) Then
If ChiediClasse(nClasse) Then
If ChiediSorte(nSorte) Then
quantitaFrz = Int(InputBox("Inserire la quantità di formazioni da visulizzare da 1 a " & Combinazioni(UBound(aNumBase),nClasse),,10))
If quantitaFrz > 0 Then
nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
If AlimentaCollFrz(aNumBase,nClasse) Then
If IsRangeValido(nEstrInizio,nEstrFine) Then
Call EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsam,nEstrValide,nEstrNonValide,nSorte)
Call ScriviParametriRicerca(DataIni,DataFin,sOraIni,sOraFin,nEstrEsam,nEstrValide,nEstrNonValide,quantitaFrz,nClasse,aNumBase,nSorte)
Call MostraFormazioniPiuFre(quantitaFrz)
End If
End If
End If
End If
End If
End If
End If
End If
End Sub
Sub ScriviParametriRicerca(DataI,DataF,OraI,OraF,EstrEsam,Valide,NonValide,QuantitaFrz,nClasse,aNumBase,nSorte)
Call Scrivi("Numeri in gioco : " & StringaNumeri(aNumBase))
Call Scrivi("Statistica delle prime " & QuantitaFrz & " formazioni piu frequenti sviluppate in " & NomeSorte(nClasse) & " per la sorte " & nSorte)
Call Scrivi
Call Scrivi("Data inizio : " & DataI)
Call Scrivi("Data fine : " & DataF)
Call Scrivi("Range Orario : " & OraI & "/" & OraF)
Call Scrivi("Estrazioni nel range : " & EstrEsam & " (Valide : " & Valide & "; NonValide : " & NonValide & ")")
Call Scrivi
End Sub
Sub MostraFormazioniPiuFre(Quantita)
Dim clsFrz
Dim k,y
Dim idFrz
ReDim aIdFrzScelte(Quantita,1)
For Each clsFrz In collPresenze
idFrz = idFrz + 1
For k = 1 To Quantita
If clsFrz.nFre >= aIdFrzScelte(k,0) Then
For y = Quantita To(k + 1) Step - 1
aIdFrzScelte(y,0) = aIdFrzScelte(y - 1,0)
aIdFrzScelte(y,1) = aIdFrzScelte(y - 1,1)
Next
aIdFrzScelte(k,0) = clsFrz.nFre
aIdFrzScelte(k,1) = idFrz
Exit For
End If
Next
Next
ReDim aV(4)
aV(1) = "Formazione"
aV(2) = "Frequenza"
aV(3) = "Ritardo"
aV(4) = "Ritardo max"
InitTabella(aV)
For k = 1 To Quantita
If k <= collPresenze.count Then
Set clsFrz = collPresenze(aIdFrzScelte(k,1))
aV(1) = clsFrz.GetNumeri
aV(2) = clsFrz.nFre
aV(3) = clsFrz.nRit
aV(4) = clsFrz.nRitMax
Call AddRigaTabella(aV)
End If
Next
Call CreaTabella
End Sub
Sub EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsaminateTot,nEstrValide,nEstrNonValide,nSorte)
Dim k,f,idEstr
Dim clsFrz
Dim p,e,nFatte
nEstrEsaminateTot = 0
nEstrValide = 0
nEstrNonValide = 0
For Each clsFrz In collPresenze
For k = nEstrInizio To nEstrFine Step 228
Call Messaggio("Estrazione : " & k)
For f = FasciaOrariaIni To FasciaOrariaFin
idEstr =(k - 1) + f
ReDim aNum(0)
Call GetEstrazioneCompletaDL(idEstr,aNum)
If aNum(1) > 0 Then
p = 0
For e = 1 To 20
If clsFrz.aNumeri(aNum(e)) Then
p = p + 1
End If
Next
If p >= nSorte Then
clsFrz.nRit = 0
clsFrz.nFre = clsFrz.nFre + 1
Else
clsFrz.nRit = clsFrz.nRit + 1
If clsFrz.nRit > clsFrz.nRitMax Then
clsFrz.nRitMax = clsFrz.nRit
End If
End If
If nFatte = 0 Then nEstrValide = nEstrValide + 1
Else
If nFatte = 0 Then nEstrNonValide = nEstrNonValide + 1
End If
If nFatte = 0 Then nEstrEsaminateTot = nEstrEsaminateTot + 1
If ScriptInterrotto Then Exit For
Next
Next
nFatte = nFatte + 1
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(1,collPresenze.count,nFatte)
Next
End Sub
Function GetItemInColl(sKey,cls)
On Error Resume Next
Set cls = collPresenze(sKey)
If Err.number <> 0 Then
Set cls = Nothing
GetItemInColl = False
Else
GetItemInColl = True
End If
End Function
Function IsRangeValido(Inizio,Fine)
Dim b
b = False
If Inizio > 0 And Fine > 0 Then
If Fine >= Inizio Then
b = True
End If
End If
If Not b Then
MsgBox "Range non valido , probabilemente mancano le estrazioni nella base dati " & _
vbCrLf & "EstrazioneIni : " & Inizio & vbCrLf & "EstrazioneFine : " & Fine
End If
IsRangeValido = b
End Function
Function ChiediDataInizioFine(DataI,DataF,GiorniDaAnalizzare)
If Not IsDate(DataF) Then DataF = FormattaStringa(Now,"dd/mm/yyyy")
If Not IsDate(DataI) Then DataI = FormattaStringa(DateAdd("d",-(GiorniDaAnalizzare),DataF),"dd/mm/yyyy")
DataI = InputBox("Inserire data inizio ricerca in formato GG/MM/AAAA","Data inizio",DataI)
DataF = InputBox("Inserire data fine ricerca in formato GG/MM/AAAA","Data fine",DataF)
If IsDate(DataI) And IsDate(DataF) Then
If DateDiff("d",DataI,DataF) >= 0 Then
ChiediDataInizioFine = True
Else
MsgBox "La data FINE deve essere maggiore od uguale alla data INIZIO"
End If
Else
MsgBox "Date inserite non valide"
End If
End Function
Function ChiediFasciaInizioFine(FasciaI,FasciaF,sOraIni,sOraFin)
FasciaI = ChiediFasciaOraria("Fascia oraria inizio",sOraIni)
FasciaF = ChiediFasciaOraria("Fascia oraria fine",sOraFin)
If FasciaI > 0 And FasciaF > 0 Then
If FasciaF >= FasciaI Then
ChiediFasciaInizioFine = True
Else
MsgBox "La fascia oraria Fine deve essere maggiore della fascia oraria INIZIO"
End If
Else
MsgBox "Fascie orarie non valide"
End If
End Function
Function ChiediFasciaOraria(sCaption,sRetOra)
On Error Resume Next
Dim aLista(228)
Dim h,m
Dim i
For h = 5 To 23
For m = 5 To 60 Step 5
i = i + 1
If m = 60 Then
aLista(i) = Format2(h + 1) & ":00"
Else
aLista(i) = Format2(h) & ":" & Format2(m)
End If
Next
Next
aLista(i) = "23:59"
i = ScegliOpzioneMenu(aLista,- 1,sCaption)
sRetOra = aLista(i)
ChiediFasciaOraria = i
End Function
Function ChiediClasse(nClasse)
ReDim aVoci(10)
Dim k
For k = 1 To 10
aVoci(k) = "Classe " & k
Next
nClasse = ScegliOpzioneMenu(aVoci,- 1,"Sviluppa combinazioni di classe")
If nClasse > 0 Then
ChiediClasse = True
Else
MsgBox "Classe formazione non valida"
End If
End Function
Function ChiediSorte(nSorte)
ReDim aVoci(10)
Dim k
For k = 1 To 10
aVoci(k) = "Sorte " & k
Next
nSorte = ScegliOpzioneMenu(aVoci,- 1,"Scegli sorte")
If nSorte > 0 Then
ChiediSorte = True
Else
MsgBox "Classe formazione non valida"
End If
End Function
Function ChiediNumeri(aNumBase)
Dim s,i,k
s = InputBox("Inserire da 1 a 20 numeri separandoli col punto <.>",,"1.2.3.4.5.6.7.8")
ReDim av(0)
Call SplitByChar(s,".",av)
ReDim aB(90)
For k = 0 To UBound(av)
If Int(av(k)) > 0 And Int(av(k)) <= 90 Then
aB(Int(av(k))) = True
End If
Next
For k = 1 To 90
If aB(k) Then
i = i + 1
ReDim Preserve aNumBase(i)
aNumBase(i) = k
End If
Next
If i > 0 And i <= 20 Then
ChiediNumeri = True
Else
MsgBox "Si devono selezionare da 1 a 20 numeri",vbExclamation
End If
End Function
Function AlimentaCollFrz(aNumBase,nClasse)
Dim k,e,s
ReDim aNumeri(UBound(aNumBase))
Dim aColonne
Dim clsFrz
Set collPresenze = GetNewCollection
If nClasse <= UBound(aNumBase) Then
Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
For k = 1 To UBound(aNumBase)
aNumeri(k) = aNumBase(k)
Next
' sviluppo il sistema valorizzando le colonne sviluppate
aColonne = SviluppoIntegrale(aNumeri,nClasse)
' scrivo le colonne in output
For k = 1 To UBound(aColonne)
Set clsFrz = New clsFormazione
' ciclo per leggere la colonna k
For e = 1 To nClasse
clsFrz.aNumeri(aColonne(k,e)) = True
Next
collPresenze.add clsFrz
Next
AlimentaCollFrz = True
Else
MsgBox "La classe è maggiore dei numeri in gioco"
AlimentaCollFrz = False
End If
End Functionl'insieme di questi due script permette di restringere molto la ricerca dei numeri e di aumentare la possibilità di centrare la vincita
Ultima modifica:
