solare
Advanced Member >PLATINUM<
Sub Main
''''' combinazioni a scelta naMe script MIKIaSceltaAmbo
'''' esplode x single / coppie e/o terzine combinazione richiesta
Dim numeri(13)
Dim art(1)
Dim r
Dim combinazione
Dim lancia
Dim des
Dim nsorte
fine = EstrazioneFin
Ord = InputBox("Ordinamento discendente per (Rit.Att. = 3) (Ritardo Max = 4) (Frequenza = 5 ) (Rit.Glob. = 6)",,6)
r = InputBox("Scegli Ruota ",,1)
art(1) = r
svi = InputBox("Sviluppo in Single - Ambo o Terno (S - A - T) ",,"S")
te = ""
If svi = "S" Or svi = "s" Then te = "Single"
If svi = "A" Or svi = "a" Then te = "Coppie"
If svi = "T" Or svi = "t" Then te = "Terzine"
des = ""
nsorte = InputBox("Sorte 1=Ambata 2=Ambo ",,1)
If nsorte = 1 Then des = " 1 = Ambata "
If nsorte = 2 Then des = " 2 = Ambo "
'scelgo numeri combinazione di ricerca
Call ScegliNumeri(numeri)
qtn = UBound(numeri)
combinazione = ""
c = 0
For c = c + 1 To qtn
combinazione = combinazione & Format2(numeri(c)) & " "
Next
Scrivi " Statistica effettuata all'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
Scrivi " Sviluppa combinazione Integrale namescript MIKIaScelta "
Scrivi " Combinazione di numeri inseriti..." & combinazione,1,- 1,- 1
Scrivi " Hai scelto lo sviluppo in " & te & " per la sorte " & des,1,- 1
Scrivi "______________________________________________________________________"
Scrivi
'scompongo combinazione numeri
ReDim aV(0)
Call SplitByChar(numeri(1),"-",aV)
ReDim atitoli(16)
' preimposto i titoli delle colonne
atitoli(1) = "Ruota "
atitoli(2) = "Numeri "
atitoli(3) = "Rit.att"
atitoli(4) = " Rit.Max"
atitoli(5) = " Freque "
atitoli(6) = " Rit.Glob."
atitoli(7) = " Rit.01 "
atitoli(8) = " Rit.02 "
atitoli(9) = " Rit.03 "
atitoli(10) = " Rit.04 "
atitoli(11) = " Rit.05 "
atitoli(12) = " Rit.06 "
atitoli(13) = " Rit.07 "
atitoli(14) = " Rit.08 "
atitoli(15) = " Rit.09 "
atitoli(16) = " Rit.10 "
' inizializzo la tabella
Call InitTabella(atitoli,1,,,5)
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in Single
If svi = "S" Or svi = "s" Then
da = 0
For da = da + 1 To qtn
ReDim nx(1)
nx(1) = Format2(numeri(da))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
'''' e riepilogo combinazione intera
da = 0
ReDim nx(13)
For da = da + 1 To qtn
nx(da) = Format2(numeri(da))
Next
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
End If
'''''---------------------------------------------------------------------------------------------------------
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in ambi
If svi = "A" Or svi = "a" Then
da = 0
a = 0
For da = da + 1 To qtn - 1
a = da
For a = a + 1 To qtn
ReDim nx(2)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
End If
'''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in terzine
If svi = "T" Or svi = "t" Then
da = 0
a = 0
af = 0
For da = da + 1 To qtn - 2
a = da
For a = a + 1 To qtn - 1
af = a
For af = af + 1 To qtn
ReDim nx(3)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))
nx(3) = Format2(numeri(af))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
Next
End If
Call CreaTabella(Int(ord))
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,fine,nsorte)
'''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
'''' somma ritardi in ritardo globale e ricerca il ritardo attuale
'''' mette in tabella ed ordina per ritardo globale discendente
somrit = 0
ReDim an(13)
For q = 1 To UBound(nx)
an(q) = Format2(nx(q))
Next
' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(16) '
aValori(1) = NomeRuota(r)
If UBound(nx) = 1 Then aValori(2) = an(1)
If UBound(nx) > 1 And UBound(nx) < 4 Then aValori(2) = an(1) & " " & an(2) & " " & an(3)
If UBound(nx) > 3 Then aValori(2) = an(1) & " " & an(2) & " " & an(3) & " " & an(4) & " " & an(5) & " " & an(6) & " " & an(7) & " " & an(8) & " " & an(9) & " " & an(10) & " " & an(11) & " " & an(12) & " " & an(13)
Call AddNumeriToGruppoStatistico(an,r)
Call StatisticaGruppoFormazioni(nsorte,RetRitardo,RetRitardoMax,Freq,sRetFormaz,EstrazioneIni,fine)
aValori(3) = RetRitardo
aValori(4) = RetRitardoMax
aValori(5) = Freq
Call ElencoRitardi(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
last10 = UBound(aRetRitardi) - 10
last = UBound(aRetRitardi)
f1 = 0
f = 6
For f1 = f1 + 1 To 10
aValori(f + f1) = aRetRitardi(last - f1)
somrit = somrit + aRetRitardi(last - f1)
Next
aValori(6) = somrit
Call AddRigaTabella(aValori,Bianco_,"center",1)
Call SetColoreCella(6,vbYellow,vbBlue)
Call SetColoreCella(3,vbYellow,vbBlue)
If retRitardo >= RetRitardoMax Then
Call SetColoreCella(3,vbRed,vbWhite)
Call SetColoreCella(4,vbRed,vbWhite)
End If
GetRitardi = Lancia
End Function
''''------------------------------------------------------------------------------------------------------------------
''''' combinazioni a scelta naMe script MIKIaSceltaAmbo
'''' esplode x single / coppie e/o terzine combinazione richiesta
Dim numeri(13)
Dim art(1)
Dim r
Dim combinazione
Dim lancia
Dim des
Dim nsorte
fine = EstrazioneFin
Ord = InputBox("Ordinamento discendente per (Rit.Att. = 3) (Ritardo Max = 4) (Frequenza = 5 ) (Rit.Glob. = 6)",,6)
r = InputBox("Scegli Ruota ",,1)
art(1) = r
svi = InputBox("Sviluppo in Single - Ambo o Terno (S - A - T) ",,"S")
te = ""
If svi = "S" Or svi = "s" Then te = "Single"
If svi = "A" Or svi = "a" Then te = "Coppie"
If svi = "T" Or svi = "t" Then te = "Terzine"
des = ""
nsorte = InputBox("Sorte 1=Ambata 2=Ambo ",,1)
If nsorte = 1 Then des = " 1 = Ambata "
If nsorte = 2 Then des = " 2 = Ambo "
'scelgo numeri combinazione di ricerca
Call ScegliNumeri(numeri)
qtn = UBound(numeri)
combinazione = ""
c = 0
For c = c + 1 To qtn
combinazione = combinazione & Format2(numeri(c)) & " "
Next
Scrivi " Statistica effettuata all'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
Scrivi " Sviluppa combinazione Integrale namescript MIKIaScelta "
Scrivi " Combinazione di numeri inseriti..." & combinazione,1,- 1,- 1
Scrivi " Hai scelto lo sviluppo in " & te & " per la sorte " & des,1,- 1
Scrivi "______________________________________________________________________"
Scrivi
'scompongo combinazione numeri
ReDim aV(0)
Call SplitByChar(numeri(1),"-",aV)
ReDim atitoli(16)
' preimposto i titoli delle colonne
atitoli(1) = "Ruota "
atitoli(2) = "Numeri "
atitoli(3) = "Rit.att"
atitoli(4) = " Rit.Max"
atitoli(5) = " Freque "
atitoli(6) = " Rit.Glob."
atitoli(7) = " Rit.01 "
atitoli(8) = " Rit.02 "
atitoli(9) = " Rit.03 "
atitoli(10) = " Rit.04 "
atitoli(11) = " Rit.05 "
atitoli(12) = " Rit.06 "
atitoli(13) = " Rit.07 "
atitoli(14) = " Rit.08 "
atitoli(15) = " Rit.09 "
atitoli(16) = " Rit.10 "
' inizializzo la tabella
Call InitTabella(atitoli,1,,,5)
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in Single
If svi = "S" Or svi = "s" Then
da = 0
For da = da + 1 To qtn
ReDim nx(1)
nx(1) = Format2(numeri(da))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
'''' e riepilogo combinazione intera
da = 0
ReDim nx(13)
For da = da + 1 To qtn
nx(da) = Format2(numeri(da))
Next
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
End If
'''''---------------------------------------------------------------------------------------------------------
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in ambi
If svi = "A" Or svi = "a" Then
da = 0
a = 0
For da = da + 1 To qtn - 1
a = da
For a = a + 1 To qtn
ReDim nx(2)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
End If
'''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in terzine
If svi = "T" Or svi = "t" Then
da = 0
a = 0
af = 0
For da = da + 1 To qtn - 2
a = da
For a = a + 1 To qtn - 1
af = a
For af = af + 1 To qtn
ReDim nx(3)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))
nx(3) = Format2(numeri(af))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
Next
End If
Call CreaTabella(Int(ord))
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,fine,nsorte)
'''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
'''' somma ritardi in ritardo globale e ricerca il ritardo attuale
'''' mette in tabella ed ordina per ritardo globale discendente
somrit = 0
ReDim an(13)
For q = 1 To UBound(nx)
an(q) = Format2(nx(q))
Next
' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(16) '
aValori(1) = NomeRuota(r)
If UBound(nx) = 1 Then aValori(2) = an(1)
If UBound(nx) > 1 And UBound(nx) < 4 Then aValori(2) = an(1) & " " & an(2) & " " & an(3)
If UBound(nx) > 3 Then aValori(2) = an(1) & " " & an(2) & " " & an(3) & " " & an(4) & " " & an(5) & " " & an(6) & " " & an(7) & " " & an(8) & " " & an(9) & " " & an(10) & " " & an(11) & " " & an(12) & " " & an(13)
Call AddNumeriToGruppoStatistico(an,r)
Call StatisticaGruppoFormazioni(nsorte,RetRitardo,RetRitardoMax,Freq,sRetFormaz,EstrazioneIni,fine)
aValori(3) = RetRitardo
aValori(4) = RetRitardoMax
aValori(5) = Freq
Call ElencoRitardi(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
last10 = UBound(aRetRitardi) - 10
last = UBound(aRetRitardi)
f1 = 0
f = 6
For f1 = f1 + 1 To 10
aValori(f + f1) = aRetRitardi(last - f1)
somrit = somrit + aRetRitardi(last - f1)
Next
aValori(6) = somrit
Call AddRigaTabella(aValori,Bianco_,"center",1)
Call SetColoreCella(6,vbYellow,vbBlue)
Call SetColoreCella(3,vbYellow,vbBlue)
If retRitardo >= RetRitardoMax Then
Call SetColoreCella(3,vbRed,vbWhite)
Call SetColoreCella(4,vbRed,vbWhite)
End If
GetRitardi = Lancia
End Function
''''------------------------------------------------------------------------------------------------------------------