Option Explicit
' ' IMPORTANTE
' "LEGGERE QUI "
' lo script viene regalato, l autore non si assume alcuna responsabilita se i dati ricavati siano corretti o meno o sul loro utilizzo
' spetta all utilizzatore finale verificarne i dati e deciderli se e come utilizzarli
' a differenza di tutti gli altri script free ( per quanto concerne le mie conoscenze) questo non solo restituisce la frequenza
' ma indica anche in quali casi ci sia stata la copertura reale.
' La percentuale " % " dei casi positivi sul totale delle condizioni rilevate è ARROTONDATA
' non modificare lo script, basta spostare una virgola per renderlo non funzionante,o, malfunzionante,o impallare il pc
' per renderlo piu leggibile e piu facile da studiare per chi è alle prime armi tutti i passaggi sono divisi in piu funzioni
' questo rallenta un po lo script, ma per studio è meglio cosi, ogni passaggio risolve un problema
'N.B:
'------------------------------------------------------------------------------------------------------------------------
' lo script è case insensitive, basta scrivere all interno degli spazi
' Lo script effettua la ricerca di un numero spia su una ruota
' presentazione filtri possibili
' 1).....scelta numero spia : da 1 a 90
' 2).....scelta Ruota: inserire il nome per esteso della ruota (N.B: non il numero no la sigla, per avvantaggiare chi è inesperto)
' 3).....numero Posizione: indica in che posizione effettuare la ricerca si puo scegliere tra : TUTTE,1,2,3,4,5
' 4).....scelta del mese: TUTTI, GENNAIO,FEBBRAIO,MARZO,ecc. Tutti = effettua la ricerca su tutto l archivio, Gennaio solo in questo mese
' ......il nome del mese va scritto per intero no abbrevizioni no numero( questo per avvantagiare chi è inesperto)
' 5).....Numero colpi: si puo inserire un numero compreso tra 1 e 18 ( ciclo teorico di un estratto)
' 6).....Numero di casi massimi compreso tra 1 e 30 , se dovessero esserci piu di 30 casi lo script esce fuori dalla ricerca
' 6).....Il carattere separatore deve essere la barra verticale (pipe)------" | "
' 7).....un solo dato errato in input non restituisce alcun output
' 8).....La Ruota su cui si effettua la ricerca è la stessa del numero spia IMPORTANTE
'------------------------------------------------------------------------------------------------------------------------
' ecco come avviene l input di default ( ovviamente si puo cambiare a piacimento)
'<<<<N.B:>>>> se viene schiacciato il tasto annulla o inserita una stringa vuota allora non viene calcolata alcuna la ricerca
' RICERCA DI DEFAULT
' | numero spia | NomeRuota | posizione | mese | numero colpi | NUMERO CASI
' | 1BA | BARI | TUTTE | MESE(Estrazionefin) | 9 ( tra 1 e 18) | tra 1 e 30
' per velocizzare le ricerche e la resa sono state utilizzate tutte le funzioni native di spaziometria ( almeno tutte quelle che conosco)
' N.B: LA PERCENTUALE DEI CASI COPERTI E' ARROTONDATA,NON CI SONO NUMERI DECIMALI
Sub Main
Dim aSpia(1),aRuota(1),aPos(2),aMes(2),aCs(1) ' aPos(1)=stringaPosizione; aPos(2)=idPosizione : aMes(1)=stringaMese; aMes(2)=idMese
Dim nClp,IdEstr,E,p
Dim nCs,nConc,nColStat,k ' variabili contatore
Dim aTitCond
Dim Ini,Fin :Call ScegliRange(Ini,Fin,EstrazioneFin - 999,EstrazioneFin)
Dim Ini_G,Fin_G,EsVer
Dim sPrompt,sTitle,inpDefault,sRic
inpDefault = " | " & FormatSpace(Estratto(Fin,1,1),2) & " | " & " BARI | TUTTE | " & UCase(MeseNome(Mese(Fin))) & " | 9 | 15 |"
Call TestoPerInputBox(sPrompt,sTitle)
sRic = InputBox(sPrompt,sTitle,inpDefault)
' INIZIO RICERCA
Call GetFiltri(sRic,aSpia,aRuota,aPos,aMes,aCs,nClp)
If ValidaDati(aSpia,aRuota,aPos,aMes,aCs,nClp) = False Then Exit Sub
' cerco le estrazioni in cui il numero spia è presente
' utilizzo la funzione nativa Elenco ritardi turbo
ReDim aRit(0),aIdEstr(0)
Call ElencoRitardiTurbo(aSpia,aRuota,1,Ini,Fin,aRit,aIdEstr)
nColStat = UBound(aIdEstr) + 11 ' Num,Ffs(53-36),Ff(35-18),Ff(17,0),FreqT,RC,Rsl,Liv,CsCop,Perc,%
ReDim aRaccDat(90,nColStat),aFiltri(30,6)
' inizializzo la matrice raccolta dati, col 1= E ; Col 2=0 (freq) ; Col 3= __ (caso neg)
For E = 1 To 90
aRaccDat(E,1) = E
For k = 2 To UBound(aRaccDat,2)
aRaccDat(E,k) = 0
Next
Next
' raccolgo le frequenze negli ultimi tre cicli,fascia 0-17,18-35,36-53
For IdEstr = Fin - 53 To Fin - 36
For p = 1 To 5
E = Estratto(IdEstr,aRuota(1),p)
aRaccDat(E,2) = aRaccDat(E,2) + 1
Next
Next
For IdEstr = Fin - 35 To Fin - 18
For p = 1 To 5
E = Estratto(IdEstr,aRuota(1),p)
aRaccDat(E,3) = aRaccDat(E,3) + 1
Next
Next
For IdEstr = Fin - 17 To Fin
For p = 1 To 5
E = Estratto(IdEstr,aRuota(1),p)
aRaccDat(E,4) = aRaccDat(E,4) + 1
Next
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
nCs = 0 ' azzero la variabile che utilizzerò successivamente per il conteggio casi
For IdEstr = UBound(aIdEstr) - 1 To 1 Step - 1
If ValidaFiltri(aIdEstr(IdEstr),aMes,aSpia,aRuota,aPos) Then
nCs = nCs + 1
nConc = aIdEstr(IdEstr)
aFiltri(nCs,1) = DataEstrazione(nConc)
aFiltri(nCs,2) = nConc
aFiltri(nCs,3) = MeseNome(Mese(nConc))
aFiltri(nCs,4) = Posizione(nConc,aRuota(1),aSpia(1))
aFiltri(nCs,5) = StringaEstratti(nConc,aRuota(1)," ")
' comincio il ciclo per contare gli estratti sortiti
Ini_G = nConc + 1
Fin_G = nConc + nClp
If Fin_G >= Fin Then Fin_G = Fin
For EsVer = Ini_G To Fin_G
ReDim aEstr(0)
Call GetArrayNumeriRuota(EsVer,aRuota(1),aEstr)
For p = 1 To 5
E = aEstr(p)
aRaccDat(E,5) = aRaccDat(E,5) + 1
aRaccDat(E,5 + nCs) = nCs
Next
Next
If nCs >= aCs(1) Then Ini = nConc: Exit For
End If
Next
Scrivi
'''''''''''''
Scrivi FormatSpace(" NON SI GARANTISCE CHE I DATI RIPORTATI SIANO ESATTI. E' VIETATA LA VENDITA DELLO SCRIPT. SE SI UTILIZZA CITARE LA FONTE (listed by [ i legend ] ",190) & Space(4),1,,RGB(0,128,255),RGB(255,255,255)
Call SetColorSezione(RGB(240,240,244))'RGB(238,237,242))
Call GetTabellaFiltro(aMes,aPos,aFiltri,nCs)
Call RibbonDati(Ini,Fin,aSpia,aRuota,aPos,aMes,nCs,aCs,nClp,aFiltri(1,2))' aFiltri(1,2)= ultimo caso(numero concorso)
Call EndColorSezione
Scrivi
Call SetColorSezione(RGB(255,255,255))
Call GetTabellaStat(aRaccDat,nCs,aRuota,Fin)
End Sub
Sub TestoPerInputBox(sPrompt,sTitle)
sTitle = "Maschera Input Filtri case InSensitive "
sPrompt = "Come inserire i Filtri di ricerca :" & vbCrLf & vbCrLf & _
"| Spia | Ru | Pos | Mese | clp | nCsMax |" & vbCrLf & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"1) Numero Spia : " & vbCrLf & _
" da 1 a 90" & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"2) Nome Ruota: (scritto per esteso :) " & vbCrLf & _
" BARI,CAGLIARI,ecc... " & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"3) numero Posizione : " & vbCrLf & _
" TUTTE = da 1 a 5 " & vbCrLf & _
" 1= in 1° pos. ; 2= in 2° pos ; ecc " & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"4) nomMese: ( scritto per esteso)" & vbCrLf & _
" TUTTI = qualsiasi mese dell anno " & vbCrLf & _
" GENNAIO= solo nel mese di gennaio" & vbCrLf & _
" ecc." & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"5) numero colpi: " & vbCrLf & _
" da 1 a 18 (ciclo teorico per estratto)" & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"6) numero di casi : Min=1 a Max=30 " & vbCrLf & _
"+-------------------------------------------------------------------+" & vbCrLf & _
"7) carattere separatore : " & vbCrLf & _
" PIPE " & Chr(34) & " | " & Chr(34) & vbCrLf
End Sub
Sub GetFiltri(sRic,aSpia,aRuota,aPos,aMes,aCs,nClp)
Dim aRicerca:aRicerca = Split(sRic,"|")
Dim i
' If UBound(aRicerca) - 1 < 5 Then aRicerca = Split(sRic,"|")
' elimino gli spazi inutili che impediscono la ricerca
For i = 1 To UBound(aRicerca) - 1
aRicerca(i) = Trim(aRicerca(i))
Next
On Error Resume Next
aSpia(1) = aRicerca(1)
aRuota(1) = UCase(aRicerca(2))
aPos(1) = UCase(aRicerca(3))
aMes(1) = UCase(aRicerca(4))
nClp = aRicerca(5)
aCs(1) = Int(aRicerca(6))
End Sub
Function ValidaDati(aSpia,aRuota,aPos,aMes,aCs,nclp)
Dim i,Count,sErr
Dim aNomRu: aNomRu = Array(0,"BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA"," ","NAZIONALE")
Dim aNumPos:aNumPos = Array("TUTTE","1","2","3","4","5")
Dim aNomeMese:aNomeMese = Array("TUTTI","GENNAIO","FEBBRAIO","MARZO","APRILE","MAGGIO","GIUGNO","LUGLIO","AGOSTO","SETTEMBRE","OTTOBRE","NOVEMBRE","DICEMBRE")
i = 0
Count = 0
sErr = ""
'------------------------------------------------------------------
If isNumeroValidoLotto(aSpia(1)) Then
Count = Count + 1
End If
'--------------------------------------------------------------------
For i = 1 To UBound(aNomRu)
If aNomRu(i) = aRuota(1) Then
aRuota(1) = i
Count = Count + 1
Exit For
End If
Next
'-------------------------------------------------------------------------
For i = 0 To UBound(aNumPos)
If aPos(1) = aNumPos(i) Then
aPos(2) = i
Count = Count + 1
Exit For
End If
Next
'--------------------------------------------------------------------------
For i = 0 To UBound(aNomeMese)
If aMes(1) = aNomeMese(i) Then
aMes(2) = i
Count = Count + 1
Exit For
End If
Next
'-------------------------------------------------------------------------------------
If IsNumeric(nclp) Then
If nclp > 0 And nclp < 19 Then
Count = Count + 1
End If
End If
'-------------------------------------------------------------------------------------
If IsNumeric(aCs(1)) Then
If aCs(1) > 0 And aCs(1) < 31 Then
Count = Count + 1
End If
End If
sErr = "UNO O PIU FILTRI INSERITI NON SONO VALIDI "
'----------------------------------------------------------------------------
ValidaDati = False
If Count = 6 Then ValidaDati = True: Else Scrivi sErr
End Function
Function ValidaFiltri(iDEstr,aMes,aSpia,aRuota,aPos)
Dim bMes,bPos,bRet
bRet = False
bPos = False
bMes = False
Select Case aMes(2)
Case 0
bMes = True
Case 1,2,3,4,5,6,7,8,9,10,11,12
If Mese(iDEstr) = aMes(2) Then bMes = True
End Select
Select Case aPos(2)
Case 0
If Posizione(iDEstr,aRuota(1),aSpia(1)) > 0 Then bPos = True
Case 1,2,3,4,5
If UCase(Posizione(iDEstr,aRuota(1),aSpia(1))) = aPos(1) Then bPos = True
End Select
If bMes = True And bPos = True Then bRet = True
ValidaFiltri = bRet
End Function
Sub RibbonDati(Ini,Fin,aSpia,aRuota,aPos,aMes,nCs,aCs,nClp,nCs1)
Dim EstrRest
Scrivi String(194,"=")
Scrivi "Range Ricerca: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace(GetInfoEstrazione(Ini) & " - " & GetInfoEstrazione(Fin),53,1) & " ",1,,RGB(250,250,250)
Scrivi "Concorsi esaminati: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace((Fin - Ini) + 1,53,1) & " ",1,,RGB(250,250,250)
Scrivi "Numero Spia: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace(aSpia(1),53,1) & " ",1,,RGB(250,250,250)
Scrivi "posizione spia: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
If aPos(2) <> 0 Then
Scrivi FormatSpace(aPos(1) & SiglaRuota(aRuota(1)),53,1) & " ",1,,RGB(250,250,250)
Else
Scrivi FormatSpace("Tutte le posizioni di " & SiglaRuota(aRuota(1)),53,1) & " ",1,,RGB(250,250,250)
End If
Scrivi "Mese Spia: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace((aMes(1)),53,1) & " ",1,,RGB(250,250,250)
Scrivi "Dati Ruota di Ricerca e Verifica: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace(NomeRuota(aRuota(1)),53,1) & " ",1,,RGB(250,250,250)
Scrivi "Estrazioni di verifica impostate: ",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace(nClp,53,1) & " ",1,,RGB(250,250,250)
Scrivi "Casi Condizioni Spia Rintracciati:",1,0,RGB(200,200,200)
Scrivi "|",,0,,,3
Scrivi FormatSpace(" [ nMaxRichiesti: (" & Format2(aCs(1)) & ")] ",31),1,0,RGB(128,255,128),RGB(0,128,192)
Scrivi FormatSpace(" Tro: " & Format2(nCs),22,1) & " ",1,,RGB(126,253,126),RGB(0,108,0)
EstrRest = nClp -(EstrazioneFin - nCs1)
Scrivi "Estrazioni da verificare: ",1,0,RGB(180,180,180)
Scrivi "|",,0,,,3
If EstrRest <= 0 Then EstrRest = "Interrotto per fine giocata" ':Else EstrRest =(nClp) - EstrRest
Scrivi FormatSpace(EstrRest,53,1) & " ",1,,RGB(255,236,236)
Scrivi String(194,"=")
End Sub
Sub GetTabellaFiltro(aMes,aPos,aFiltri,nCs)
Dim aTitCond,i,k,j
ReDim aTab(6)
aTitCond = Array(0,"nCS","Data_Cond","Conc","Mese:" & aMes(1),"Pos:" & aPos(1),"Estratti")
Call InitTabella(aTitCond)
k = 0
For i = nCs To 1 Step - 1
k = k + 1
aTab(1) = i
For j = 1 To 5
aTab(j + 1) = aFiltri(k,j)
Next
Call AddRigaTabella(aTab)
Next
Call SetTableHeight("25%")
Call SetTableWidth("100%")
Call SetTableTitle(" Concorsi filtrati",,,1,RGB(128,64,64),,0)
Call CreaTabellaOrdinabile()
End Sub
Sub GetTabellaStat(aRaccDat,nCs,aRuota,Fin)
Dim e,i,j,F,K,Per,nCsCop,sCop,Rit,nRSL,nLiv,sNumSinc
Dim aTit:aTit = Array(0,"Num","Fr(F(53-36))","Fr(F(35-18))","Fr(F(17-0))","FreqT","nCop","PercArr","%","RitCr","RitLiv","nLiv","Tabellone" & String(10,"-"),"id Casi Coperti" & String(100,"-"))
Call InitTabella(aTit,,"LEFT",,,"COURIER New")
' mettere tutto in tabella
For e = 1 To 90
i = aRaccDat(e,1)
F = aRaccDat(e,2)
nCsCop = 0
sCop = ""
K = 0
For j = 6 To nCs + 5
If aRaccDat(e,j) <> 0 Then
nCsCop = nCsCop + 1
sCop = sCop & Format2(nCs - K) & "-"
' Else
' sCop = sCop & "XX" & "-"
End If
K = K + 1
Next
sCop = RimuoviLastChr(sCop,"-")
Call RitSincDiLivTurbo(i,aRuota(1),Fin,Rit,nRSL,nLiv,sNumSinc)
Per = Round(nCsCop/nCs,2)*100
Dim aTab
aTab = Array(0,Int(i),F,aRaccDat(e,3),aRaccDat(e,4),aRaccDat(e,5),nCsCop,Per,"%",Rit,nRSL,nLiv,sNumSinc,sCop)
Call AddRigaTabella(aTab,,"left",12,,"COURIER NEW")
Call SetColoreCella(1,RGB(128,128,192),RGB(240,240,240))',RGB(19,152,12))
If aTab(2) = 0 Then Call SetColoreCella(2,RGB(255,255,245),vbRed): Else Call SetColoreCella(2,RGB(242,242,245),RGB(0,103,125))
If aTab(3) = 0 Then Call SetColoreCella(3,RGB(255,255,245),vbRed): Else Call SetColoreCella(3,RGB(242,242,245),RGB(0,103,125))
If aTab(4) = 0 Then Call SetColoreCella(4,RGB(255,255,245),vbRed): Else Call SetColoreCella(4,RGB(242,242,245),RGB(0,103,125))
Call SetColoreCella(5,RGB(176,228,253),0)
Call SetColoreCella(6,RGB(176,205,253),RGB(51,96,113))
Call SetColoreCella(7,RGB(234,213,213),RGB(128,64,64))
Call SetColoreCella(8,RGB(234,213,213),RGB(128,64,64))
Next
Scrivi
Call SetTableHeight("50%")
Call SetTableWidth("100%")
Call SetTableTitle(" Raccolta dati ",,,1,RGB(128,64,64),,0)
Call CreaTabellaOrdinabile(6,- 1)
End Sub
Sub RitSincDiLivTurbo(NumeroAnalizzato,Ruota,idEstrFin,Rit,nRSL,nLiv,sNumSinc)
Dim idTemp,idPrima
Dim idEstr
Dim p
Dim aN(1)
Dim aRu(1)
Dim aSinc(5)
aN(1) = NumeroAnalizzato
aRu(1) = Ruota
idEstr = SerieUltima(1,idEstrFin,aN,aRu,1)
Rit = idEstrFin - idEstr
ReDim aE(0)
Call GetArrayNumeriRuota(idEstr,aRu(1),aE)
If UBound(aE) = 0 Then
Rit = 0 ' "--"
nRSL = 0 ' "--"
nLiv = 0 ' "--"
sNumSinc = "-- -- -- -- --"
Else
nLiv = 0
idTemp = 0
For p = 1 To 5
aN(1) = aE(p)
If SerieUltima(idEstr,idEstrFin,aN,aRu,1) = idEstr Then
nLiv = nLiv + 1
aSinc(p) = aN(1)
Else
aSinc(p) = "--"
idPrima = SeriePrima(idEstr + 1,idEstrFin,aN,aRu,1)
If idTemp < idPrima Then idTemp = idPrima
End If
Next
If idTemp = 0 Then idTemp = idEstr ' questo se nessun estratto è caduto
nRSL = idEstrFin - idTemp ' questo calcola il ritardo di livello ;-)
sNumSinc = StringaNumeri(aSinc," ",True)
End If
End Sub
per me è un piacere rispondere ad alcune "piccolezze",
