Script "Rubino - Abasul" testato e funzionante correttamente
Sub Main
''''-------------------------------------------------------------------------------------------
''''scelta combinazioni dall'ambo secco alla decina x ambo ABASULmultiAmbo5
''''-------------------------------------------------------------------------------------------
ReDim aVoci(10)
ReDim aVociSel(10)
Dim k
Dim numeri
Dim LenghtcicloT
For k = 0 To 10
If k < 2 Then aVoci(k) = "----"
If k = 2 Then aVoci(k) = "Ambo"
If k = 3 Then aVoci(k) = "Terzina"
If k = 4 Then aVoci(k) = "Quartina"
If k = 5 Then aVoci(k) = "Cinquina"
If k = 6 Then aVoci(k) = "Sestina"
If k = 7 Then aVoci(k) = "Settina"
If k = 8 Then aVoci(k) = "Ottina"
If k = 9 Then aVoci(k) = "Novina"
If k = 10 Then aVoci(k) = "Decina"
Next
If ScegliDaLista(aVoci,aVociSel) > 0 Then
For k = 2 To 10
If aVociSel(k) Then
Do While numeri = ""
numeri = InputBox("inserire " & k & " numeri suddivisi da virgola ",,"")
ReDim av2(0)
Call SplitByChar(numeri,",",av2)
qta = UBound(av2) + 1
If numeri = "" Or qta <> k Then
MsgBox("Mancano numeri o numeri errati " & qta & " " & k & "...." & numeri)
numeri = ""
Else
Exit Do
End If
Loop
If k = 2 Then LenghtcicloT = 400.5
If k = 3 Then LenghtcicloT = 136.6046511628
If k = 4 Then LenghtcicloT = 69.8998768978
If k = 5 Then LenghtcicloT = 42.9265011828
If k = 6 Then LenghtcicloT = 28.7918133849
If k = 7 Then LenghtcicloT = 20.9186742695
If k = 8 Then LenghtcicloT = 15.9462278131
If k = 9 Then LenghtcicloT = 12.596876878
If k = 10 Then LenghtcicloT = 10.2283345991
Call Scrivi(aVoci(k))
Call Scrivi(numeri)
End If
Next
End If
''''' -----------------------------------------------------------------------------------------------------------------------------
'''abasul10
Dim sfile
Dim records
Dim art(1)
Dim dif(2000)
Dim num(10)
Dim anum(10)
Dim t
Dim t2
Dim Media
r = InputBox("Inserire Ruota ",,1)
capo = numeri
Do While futuroins = ""
futuroins = InputBox("Inserire Ritardo Futuro..",,"")
If futuroins = "" Then
MsgBox("Manca valore ritardo futuro")
Else
Exit Do
End If
Loop
ReDim av2(0)
Call SplitByChar(numeri,",",av2)
qta = UBound(av2) + 1
For i = 0 To qta - 1
fs = i + 1
num(fs) = av2(i)
anum(fs) = av2(i)
Next
'''preimposta inizio estrazioni per ruote nate recentemente
''' per nazionale imposta dal conc.n. 7440
dal = 1 ' inizio tutte le altre ruote
If r = 12 Then dal = 7440 'inizio nazionale
If r = 1 Then dal = 174 'inizio bari
If r = 2 Then dal = 3649 'inizio cagliari
If r = 4 Then dal = 3577 'inizio genova
ReDim asvil(2000)
art(1) = r
ctr = 0
Iniz = dal
ini = dal
al = Iniz - 1
ciclicompleti =(EstrazioneFin - dal)/LenghtcicloT
parziale = Int(ciclicompleti)*LenghtcicloT
intermed =((EstrazioneFin - dal) - parziale) + 1
Call Messaggio(NomeRuota(r) & "...Elabora Combinazione richiesta...." & capo)
tq = 0
ReDim atitoli(7)
' preimposto i titoli delle colonne
atitoli(1) = " Riferimenti estraz.passato "
atitoli(2) = " Ritardo "
atitoli(3) = " Totale Ritardo "
atitoli(4) = " Media Ritardo "
atitoli(5) = " scarto md.quadratico "
atitoli(6) = " Diff.smdq Prec."
atitoli(7) = " Es."
' inizializzo la tabella
Call InitTabella(atitoli,1,"center",2,5)
Dim cx
For Ini = Ini + 1 To EstrazioneFin
ok = 0
estratti = ""
des2 = ""
des1 = ""
rambo = ""
Call AvanzamentoElab(1,EstrazioneFin,ini)
' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(7) '
For h = 1 To 5
For fr = 1 To 10
If Int(num(fr)) > 0 And Int(num(fr)) = Estratto(Ini,r,h) Then
ok = ok + 1
des2 = des2 & Format2(Estratto(Ini,r,h)) & " "
End If
Next
estratti = estratti & Format2(Estratto(Ini,r,h)) & " "
Next
If ok >= 2 Then
If ok = 2 Then
Totambi = Totambi + 1
aValo
