Option Explicit
' Salvo Errori sempre possibili
'Richiesta utente Bubblegum su lottoced
rem
' Titolo post : Richiesta
'Ciao forum , vorrei chiedere ai maestri se gentilmente potessero realizzare questo script : ricercare su una ruota scelta quella unica somma uguale o minore a 90 ottenuta da tre estratti che abbia una determinata cadenza (se possibile con inputbox)
'Questi esempi chiariranno la condizione di ricerca :
'Ruota : Genova
'Cadenza della somma : 0
'Il 25-01-2007 -- Genova 73-13-28-39-90
'13+28+39 = 80 , è l'unica somma che dà il valore richiesto ovvero uguale o minore a 90 con cadenza 0 (OK)
'--------------------
'Ruota : Napoli
'Cadenza della somma : 8
'25-01-2007-- Napoli 53-84-46-9-33
'46+9+33 = 88 , anche qui unica somma uguale o minore a 90 con cadenza richiesta 8 (OK)
'--------------------
'Sempre nella stessa data di estrazione
'Cagliari 22-29-37-56-5
'Qui abbiamo più somme a tre estratti minori o uguale 90 , ma deve essere solo una
'5+22+29 = 56
'5+29+37 = 71
'5+22+56 = 83
'5+29+56 = 90
'22+29+37 = 88
'Altro esempio che non soddisfa : qui ne abbiamo due
'20-02-2016 -- Milano 59-48-2-32-52
'2+32+48 = 82
'2+32+52 = 86
'Grazie e ciao
rem
Sub Main
Dim i,sum,IdEstr,Id,j,T,Cad,s,M,jj,a
ReDim aNum(0),aCol(2)
Dim aTit
Dim Ini,Fin:Call ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin)
Dim R:R = ScegliRuota:If R = 11 Then Exit Sub
Dim aVclasse:aVclasse = Array(2,3,4,5)
Dim Classe:Classe = ScegliOpzioneMenu(aVclasse,1,"Seleziona Classe di sviluppo") + 2
Dim ColT:ColT = Combinazioni(5,Classe)
ReDim aVSpia(ColT - 1)
For a = 1 To ColT
aVSpia(a - 1) = a
Next
Dim TSpia:TSpia = ScegliOpzioneMenu(aVSpia,0,"Seleziona quante formazioni <=90 ") + 1
ReDim aPMin(TSpia - 1)
For a = 1 To TSpia
aPMin(a - 1) = a
Next
Dim qTspia:qTspia = ScegliOpzioneMenu(aPMin,0,"Seleziona Presenze minime Cadenza Voluta") + 1
Dim aVCad:aVCad = Array(0,1,2,3,4,5,6,7,8,9)
Dim ICad:ICad = ScegliOpzioneMenu(aVCad,0,"Seleziona cadenza somma")
ReDim aComb(ColT),aCad(ColT)
Call GetTitTab(aTit,Classe)
Dim col:col = UBound(aTit)
ReDim aTab(col + 2)
For IdEstr = Ini To Fin
Call AvanzamentoElab(Ini,Fin,IdEstr)
Call GetArrayNumeriRuota(IdEstr,R,aNum)
If aNum(1) > 0 Then
Call InitSviluppoIntegrale(aNum,Classe)
T = 0
Id = 0
Do While GetCombSviluppo(aNum)
Id = Id + 1
sum = 0
For i = 1 To Classe
sum = sum + aNum(i)
Next
If sum <= 90 Then s = StringaNumeri(aNum,"+",True) & "=" & sum :Cad = Cadenza(sum):T = T + 1:Else s = "":Cad = - 1
aComb(Id) = s
aCad(Id) = Cad
Loop
ReDim aTab(col)
Call GetTab(aTab,IdEstr,R,aComb,aCad)
If T = TSpia Then
Dim idtT
M = 0
For jj = 1 To UBound(aCad)
If aCad(jj) = ICad Then M = M + 1
Next
If M = qTspia Then
aCol(1) = RGB(201,228,250)
Call AddRigaTabella(aTab,aCol(1),,,RGB(12,74,126))
idtT = idtT + 1
For j = 3 To UBound(aTab)
If aTab(j) <> "" And aTab(j) <> - 1 Then aCol(1) = RGB(242,241,245):aCol(2) = RGB(55,55,55):Else aCol(1) = vbWhite:aCol(2) = vbWhite
Call SetColoreCella(Int(j),aCol(1),aCol(2))
If ScriptInterrotto Then Exit For
Next
aCol(1) = vbWhite
End If
End If
End If
Next
Dim sTit:sTit = " Range: " & Ini & "-" & Fin & " formazioni somme<=90: " & TSpia & " Casi Rintracciati: " & idtT & " Ruota di ricerca: " & NomeRuota(R) & " CadenzaSpia: " & ICad & " Presenze cadenza= " & qTspia
Call SetTableTitle(sTit,,,True,,vbWhite)
Call SetTableWidth("100%")
Call CreaTabellaOrdinabile
End Sub
Sub GetTitTab(aTit,Classe)
Dim i,m,e,j
ReDim aN(5):aN(1) = 1:aN(2) = 2:aN(3) = 3:aN(4) = 4:aN(5) = 5
Dim aE
Dim col
col = InitSviluppoIntegrale(aN,Classe)
ReDim aN1(col)
ReDim aTit(2 + col*2):aTit(1) = "Conc":aTit(2) = "Estrazione"
Do While GetCombSviluppo(aN)
j = j + 1
aN1(j) = StringaNumeri(aN,"+")
Loop
For i = 3 To UBound(aTit) - 1 Step(2)
m = m + 1
aTit(i) = "E(" & aN1(m) & ")"
aTit(i + 1) = "C"
Next
e = ""
Call InitTabella(aTit)
End Sub
Sub GetTab(aTab,IdEstr,R,aComb,aCad)
Dim i,j
aTab(1) = IdEstr
aTab(2) = StringaEstratti(IdEstr,R)
For i = 3 To UBound(aTab) - 1 Step 2
j = j + 1
aTab(i) = aComb(j)
aTab(i + 1) = aCad(j)
Next
End Sub
