Halmun
Advanced Member >PLATINUM<
riprendo un mio vecchio metodo messo in script da LuigiB e modificato da Gian332 chiedendo gentilmente ai più esperti se sia possibile evidenziare le 5 classifiche come nella foto sottostante, evidenziando pero' in ROSSO i Delta fra i 5 estratti.
attualmente lo script li incolonna tutti impedendo pertanto di vedere a colpo d'occhio i Delta fra i 5 estratti.
segue esempio su BARI con fine analisi al 05/11/2022 :
osservando le 2 foto allegate troviamo come Primo delta il 2° e 5° estratto con valore Delta identico = a 1,471
che pone in gioco la terzina 63 43 10.
mentre, sempre come esempio, Abbiamo come Secondo DELTA la coppia 30 02 corrispondente al 4° e 5° estratto
rispettivamente con DELTA = a 1,438
ringrazio anticipatamente chiunque possa modificare il seguente script.
----------------------------------------------------------------------------------------------------------
Option Explicit
'QUESTO SCRIPT è STATO ORIGINARIAMENTE SCRITTO DA LuigiB SU RICHIESTA DI HALMUN PER FACILITARE LA RICERCA
' DEI NUMERI OTTIMALI INERENTI IL METODO SPAZIO DELTA
'E MODIFICATO DA GIAN332 IN DATA 07/12/2012
Class clsNumero
Dim N
Dim nUscite
Dim nUsciteRip
Private nDelta
Public Property Get Delta()
Delta = nDelta
End Property
Sub CalcolaDelta
nDelta = Round(Dividi(nUsciteRip,nUscite),3)
nDelta = Replace(nDelta,",",".")
End Sub
End Class
Class clsPosClassifica
Private collNumeri
Dim nDelta
Sub Class_Initialize
Set collNumeri = GetNewCollection
End Sub
Sub AddItemColl(ClsNum)
collNumeri.Add ClsNum
End Sub
Function GetNumeri
Dim ClsNum
Dim s
For Each ClsNum In collNumeri
s = s & Format2(ClsNum.n) & "."
Next
If Right(s,1) = "." Then s = Left(s,Len(s) - 1)
GetNumeri = s
End Function
Function QuantitaNumeri(aNumInGioco)
Dim ClsNum
Dim i
i = 0
For Each ClsNum In collNumeri
i = i + 1
ReDim Preserve aNumInGioco(i)
aNumInGioco(i) = ClsNum.N
Next
QuantitaNumeri = i
End Function
End Class
Sub Main
Dim nRuota,idEstr
Dim Inizio,Fine,ColpiVerifica
Dim nSpia,nPosSpia,nColpiSucc
Dim CollNumeri,CollClassifica
Dim ClsNum,clsNTmp
Dim clsPosCla
Dim k,kk
Dim iEstrAna,EstrazioneInizioTest
Dim nColpiGioco
Dim nLimitePrimePos
Dim f
Dim nGiocata
Dim sNumInGioco,sLastNumInGioco
Dim nRetColpi
'nRuota = ScegliRuota
nPosSpia = 1
For nRuota = 1 To 1 ' 1 TO 20 SCANSIONA TUTTE LE RUOTE
For nPosSpia = 1 To 5 ' 1 TO 5 SCANSIONA TUTTI I CINQUE ESTRATTI
Fine = EstrazioneFin - 22 'QUI POSSO INPOSTARE IL FINE ARCHIVIO IN MODO DA POTER FARE VERIFICHE
'inpostare ( - 0 ) per l'ultima estrazione disponibile in archivio
Inizio = 03862 'Fine - 3 '03862 EstrazioneIni 5/1/1945
idEstr = Fine
nColpiSucc = 9 'QUI POSSO INPOSTARE I COLPI SUCCESSIVI A PIACIMENTO (DEFAULT 9)
EstrazioneInizioTest = Fine - nColpiSucc ' INIZIO DEL TEST è dato da FINE - n°colpi successivi(9) dall'estrazione di INIZIO
nSpia = Estratto(idEstr,nRuota,nPosSpia)
If nSpia > 0 And nSpia <= 90 And nPosSpia > 0 And nPosSpia <= 5 And EstrazioneInizioTest > 0 And nColpiSucc > 0 Then
For iEstrAna = EstrazioneInizioTest To Fine
Call InitCollNumeri(CollNumeri)
Call Messaggio("RUOTA " & nRuota & " [SPIA " & nSpia & "] [" & nPosSpia & "°pos] su estrazione " & iEstrAna & " mancanti " &(Fine - iEstrAna))
For idEstr = Inizio To iEstrAna
If Estratto(idEstr,nRuota,nPosSpia) = nSpia Then
For Each ClsNum In CollNumeri
If idEstr + nColpiSucc <= iEstrAna Then
f = EstrattoFrequenza(nRuota,ClsNum.n,idEstr + 1,idEstr + nColpiSucc)
Else
f = EstrattoFrequenza(nRuota,ClsNum.n,idEstr + 1,iEstrAna)
End If
If f > 0 Then
ClsNum.nUscite = ClsNum.nUscite + 1 'conteggio sortite
ClsNum.nUsciteRip = ClsNum.nUsciteRip + f ' conteggio ripetizzioni
End If
Next
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
For Each ClsNum In CollNumeri
Call ClsNum.CalcolaDelta
Next
Call OrdinaItemCollection(CollNumeri,"Delta",,,0)
Set CollClassifica = GetNewCollection
For k = 1 To 90
Set ClsNum = CollNumeri(k)
Set clsPosCla = New clsPosClassifica
clsPosCla.nDelta = ClsNum.Delta
For kk = k To 90
k = kk
Set clsNTmp = CollNumeri(kk)
If clsNTmp.Delta = clsPosCla.nDelta Then
Call clsPosCla.AddItemColl(clsNTmp)
Else
k = kk - 1
Exit For
End If
Next
If k <= 90 Then Call AddItemCollClassifica(CollClassifica,clsPosCla)
Next
ReDim aNumInGioco(0)
'Call Scrivi(String(100,"-"))
If ScriptInterrotto Then Exit For
Next
'Call ScriviResoconto
ReDim aV(2)
aV(1) = "Delta"
aV(2) = "Numeri"
Call InitTabella(aV)
For Each clsPosCla In CollClassifica
aV(1) = clsPosCla.nDelta
aV(2) = clsPosCla.GetNumeri
Call AddRigaTabella(aV)
Next
'Call Scrivi("archivio Spaziometria da estrazz. numero " & Inizio & " a estrazz " & Fine)
Call Scrivi("TOT estrazioni analizzate " & Fine - Inizio & " -DALLA- " & GetInfoEstrazione(Inizio) & " -ALLA- " & GetInfoEstrazione(Fine))
Call Scrivi("RUOTA " & nRuota & " delta spia " & nSpia & " pos°" & nPosSpia & " su estrazione " & iEstrAna - 1 & " ultima anal" & GetInfoEstrazione(Fine))
Call CreaTabella
Else
MsgBox "Parametri di ricerca non validi",vbExclamation
End If
Next 'nPosSpia = nPosSpia+1
Next 'ruota
End Sub
Function VerificaCondizioneDiGioco(CollClassifica,nLimitePrimePos,aNumInGioco)
Dim clsP
Dim i
For Each clsP In CollClassifica
i = i + 1
If clsP.QuantitaNumeri(aNumInGioco) > 1 Then 'se voglio trovare 5 num inseriro >5
VerificaCondizioneDiGioco = True
Exit For
End If
If i > nLimitePrimePos Then Exit For
Next
End Function
Sub AddItemCollClassifica(CollClassifica,clsPosCla)
On Error Resume Next
Call CollClassifica.Add(clsPosCla,"k" & clsPosCla.nDelta)
End Sub
Sub InitCollNumeri(collNumeri)
Dim k
Dim ClsNum
Set collNumeri = GetNewCollection
For k = 1 To 90
Set ClsNum = New clsNumero
ClsNum.n = k
collNumeri.Add ClsNum
Next
End Sub
---------------------------------------------------------------------------------------------------------------------------
attualmente lo script li incolonna tutti impedendo pertanto di vedere a colpo d'occhio i Delta fra i 5 estratti.
segue esempio su BARI con fine analisi al 05/11/2022 :
osservando le 2 foto allegate troviamo come Primo delta il 2° e 5° estratto con valore Delta identico = a 1,471
che pone in gioco la terzina 63 43 10.
mentre, sempre come esempio, Abbiamo come Secondo DELTA la coppia 30 02 corrispondente al 4° e 5° estratto
rispettivamente con DELTA = a 1,438
ringrazio anticipatamente chiunque possa modificare il seguente script.
----------------------------------------------------------------------------------------------------------
Option Explicit
'QUESTO SCRIPT è STATO ORIGINARIAMENTE SCRITTO DA LuigiB SU RICHIESTA DI HALMUN PER FACILITARE LA RICERCA
' DEI NUMERI OTTIMALI INERENTI IL METODO SPAZIO DELTA
'E MODIFICATO DA GIAN332 IN DATA 07/12/2012
Class clsNumero
Dim N
Dim nUscite
Dim nUsciteRip
Private nDelta
Public Property Get Delta()
Delta = nDelta
End Property
Sub CalcolaDelta
nDelta = Round(Dividi(nUsciteRip,nUscite),3)
nDelta = Replace(nDelta,",",".")
End Sub
End Class
Class clsPosClassifica
Private collNumeri
Dim nDelta
Sub Class_Initialize
Set collNumeri = GetNewCollection
End Sub
Sub AddItemColl(ClsNum)
collNumeri.Add ClsNum
End Sub
Function GetNumeri
Dim ClsNum
Dim s
For Each ClsNum In collNumeri
s = s & Format2(ClsNum.n) & "."
Next
If Right(s,1) = "." Then s = Left(s,Len(s) - 1)
GetNumeri = s
End Function
Function QuantitaNumeri(aNumInGioco)
Dim ClsNum
Dim i
i = 0
For Each ClsNum In collNumeri
i = i + 1
ReDim Preserve aNumInGioco(i)
aNumInGioco(i) = ClsNum.N
Next
QuantitaNumeri = i
End Function
End Class
Sub Main
Dim nRuota,idEstr
Dim Inizio,Fine,ColpiVerifica
Dim nSpia,nPosSpia,nColpiSucc
Dim CollNumeri,CollClassifica
Dim ClsNum,clsNTmp
Dim clsPosCla
Dim k,kk
Dim iEstrAna,EstrazioneInizioTest
Dim nColpiGioco
Dim nLimitePrimePos
Dim f
Dim nGiocata
Dim sNumInGioco,sLastNumInGioco
Dim nRetColpi
'nRuota = ScegliRuota
nPosSpia = 1
For nRuota = 1 To 1 ' 1 TO 20 SCANSIONA TUTTE LE RUOTE
For nPosSpia = 1 To 5 ' 1 TO 5 SCANSIONA TUTTI I CINQUE ESTRATTI
Fine = EstrazioneFin - 22 'QUI POSSO INPOSTARE IL FINE ARCHIVIO IN MODO DA POTER FARE VERIFICHE
'inpostare ( - 0 ) per l'ultima estrazione disponibile in archivio
Inizio = 03862 'Fine - 3 '03862 EstrazioneIni 5/1/1945
idEstr = Fine
nColpiSucc = 9 'QUI POSSO INPOSTARE I COLPI SUCCESSIVI A PIACIMENTO (DEFAULT 9)
EstrazioneInizioTest = Fine - nColpiSucc ' INIZIO DEL TEST è dato da FINE - n°colpi successivi(9) dall'estrazione di INIZIO
nSpia = Estratto(idEstr,nRuota,nPosSpia)
If nSpia > 0 And nSpia <= 90 And nPosSpia > 0 And nPosSpia <= 5 And EstrazioneInizioTest > 0 And nColpiSucc > 0 Then
For iEstrAna = EstrazioneInizioTest To Fine
Call InitCollNumeri(CollNumeri)
Call Messaggio("RUOTA " & nRuota & " [SPIA " & nSpia & "] [" & nPosSpia & "°pos] su estrazione " & iEstrAna & " mancanti " &(Fine - iEstrAna))
For idEstr = Inizio To iEstrAna
If Estratto(idEstr,nRuota,nPosSpia) = nSpia Then
For Each ClsNum In CollNumeri
If idEstr + nColpiSucc <= iEstrAna Then
f = EstrattoFrequenza(nRuota,ClsNum.n,idEstr + 1,idEstr + nColpiSucc)
Else
f = EstrattoFrequenza(nRuota,ClsNum.n,idEstr + 1,iEstrAna)
End If
If f > 0 Then
ClsNum.nUscite = ClsNum.nUscite + 1 'conteggio sortite
ClsNum.nUsciteRip = ClsNum.nUsciteRip + f ' conteggio ripetizzioni
End If
Next
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
For Each ClsNum In CollNumeri
Call ClsNum.CalcolaDelta
Next
Call OrdinaItemCollection(CollNumeri,"Delta",,,0)
Set CollClassifica = GetNewCollection
For k = 1 To 90
Set ClsNum = CollNumeri(k)
Set clsPosCla = New clsPosClassifica
clsPosCla.nDelta = ClsNum.Delta
For kk = k To 90
k = kk
Set clsNTmp = CollNumeri(kk)
If clsNTmp.Delta = clsPosCla.nDelta Then
Call clsPosCla.AddItemColl(clsNTmp)
Else
k = kk - 1
Exit For
End If
Next
If k <= 90 Then Call AddItemCollClassifica(CollClassifica,clsPosCla)
Next
ReDim aNumInGioco(0)
'Call Scrivi(String(100,"-"))
If ScriptInterrotto Then Exit For
Next
'Call ScriviResoconto
ReDim aV(2)
aV(1) = "Delta"
aV(2) = "Numeri"
Call InitTabella(aV)
For Each clsPosCla In CollClassifica
aV(1) = clsPosCla.nDelta
aV(2) = clsPosCla.GetNumeri
Call AddRigaTabella(aV)
Next
'Call Scrivi("archivio Spaziometria da estrazz. numero " & Inizio & " a estrazz " & Fine)
Call Scrivi("TOT estrazioni analizzate " & Fine - Inizio & " -DALLA- " & GetInfoEstrazione(Inizio) & " -ALLA- " & GetInfoEstrazione(Fine))
Call Scrivi("RUOTA " & nRuota & " delta spia " & nSpia & " pos°" & nPosSpia & " su estrazione " & iEstrAna - 1 & " ultima anal" & GetInfoEstrazione(Fine))
Call CreaTabella
Else
MsgBox "Parametri di ricerca non validi",vbExclamation
End If
Next 'nPosSpia = nPosSpia+1
Next 'ruota
End Sub
Function VerificaCondizioneDiGioco(CollClassifica,nLimitePrimePos,aNumInGioco)
Dim clsP
Dim i
For Each clsP In CollClassifica
i = i + 1
If clsP.QuantitaNumeri(aNumInGioco) > 1 Then 'se voglio trovare 5 num inseriro >5
VerificaCondizioneDiGioco = True
Exit For
End If
If i > nLimitePrimePos Then Exit For
Next
End Function
Sub AddItemCollClassifica(CollClassifica,clsPosCla)
On Error Resume Next
Call CollClassifica.Add(clsPosCla,"k" & clsPosCla.nDelta)
End Sub
Sub InitCollNumeri(collNumeri)
Dim k
Dim ClsNum
Set collNumeri = GetNewCollection
For k = 1 To 90
Set ClsNum = New clsNumero
ClsNum.n = k
collNumeri.Add ClsNum
Next
End Sub
---------------------------------------------------------------------------------------------------------------------------
Allegati
Ultima modifica:
per capire bene le tue esigenze e scegliere la migliore/fattibile opzione per la soluzione.
