il plugin infatti non funziona.
scusate l'intromissione, ho lo script che rubino aveva postato a suo tempo, dove avevo preso dei miei appunti.
anche se non lo uso quasi mai.
[codice]
Sub Main
''''' combinazioni a scelta script MIKI55Capog (Rubino)
Dim art(1)
Dim r,combinazione,lancia,des,nsorte,fine,Ini,ord,svi,c,qtn,da,a,af,cap,abbin,te,ct,nx,max,nc,defaul,diecicicli,rttdet
r = InputBox("Scegli Ruota ",,5)
cap = CInt(InputBox("Capogioco ",,68))
nc = InputBox("Len ciclo Equilibrio Instabile su TT",,2)
defaul = InputBox("Estr.Determinati S=Scarto R=Usc.Reali",,"R")
diecicicli = InputBox("Estr.Determinati Rilevamento 10c=10cicli o ST=Storico",,"10")
rttdet = InputBox("Vuoi presenze Est.Determinato su TT=Tutte o RF=Ruota ?",,"TT")
fine = EstrazioneFin
art(1) = r
svi = "S" : te = ""
If svi = "S" Or svi = "s" Then te = "Single-Coppia Abbinata "
Ini = EstrazioneIni ' inizio tutte le altre ruote
If r = 12 Then Ini = 7440 'inizio nazionale
If r = 1 Then Ini = 174 'inizio bari
If r = 2 Then Ini = 3649 'inizio cagliari
If r = 4 Then Ini = 3577 'inizio genova
des = "" : nsorte = 1
If nsorte = 1 Then des = " 1 = Ambata "
Scrivi " Statistica dall'estrazione " & Ini & " / " & DataEstrazione(Ini) & " - All'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
If diecicicli <> "ST" And diecicicli <> "st" Then Scrivi " Rilevo Estratti Determinati su Lunghezza Ciclo..uguale a 10 Cicli ",1
If diecicicli = "ST" Or diecicicli = "st" Then Scrivi " Rilevo Estratti Determinati su Lunghezza Ciclo (Storico) " & "Range dall'estrazione n. " & Ini & " alla n. " & fine,1
If rttdet <> "RF" Then Scrivi " Rilevo Estratti Determinati su Tutte le ruote su Lunghezza Ciclo (" & nc & " * 18) " & "Range dall'estrazione n. " &(fine + 1) -(18*nc) & " alla n. " & fine,1
If rttdet <> "TT" Then Scrivi " Rilevo Estratti Determinati su Tutte le ruote su Lunghezza Ciclo (" & nc & " * 180) " & "Range dall'estrazione n. " &(fine + 1) -(180*nc) & " alla n. " & fine,1
If defaul = "R" Then
Scrivi " Rileva Estratti Determinati Reali su Ruota Fissa nel range di date scelte ",1
Else
Scrivi " Rileva Estratti Determinati (Scarto) su Ruota Fissa nel range di date scelte ",1
End If
Scrivi " Rileva presenze Estratto Determinato su Ruota = " & rttdet,1
Scrivi "____script = Miki55CapogSingle-Ambo____________________________________________R u b i n o____________________________________________________________",1,- 1,3
Scrivi " C a p o g i o c o R i c h i e s t o ...." & cap,1,- 1,3
ReDim atitoli(37)
' preimposto i titoli delle colonne
atitoli(1) = "Ruota "
atitoli(2) = "Numeri "
atitoli(3) = "Rit.att"
atitoli(4) = " RitMx"
atitoli(5) = " Freq."
atitoli(6) = " Rt.Gl"
atitoli(7) = " Rit01 "
atitoli(8) = " Rit02 "
atitoli(9) = " Rit03 "
atitoli(10) = " Rit04 "
atitoli(11) = " Rit05 "
atitoli(12) = " Rit06 "
atitoli(13) = " Rit07 "
atitoli(14) = " Rit08 "
atitoli(15) = " Rit09 "
atitoli(16) = " Rit10 "
atitoli(17) = " "
atitoli(18) = " RtAmbo"
atitoli(19) = " RtAmboTT"
atitoli(20) = " Eds1"
atitoli(21) = " Eds2"
atitoli(22) = " Eds3"
atitoli(23) = " Eds4"
atitoli(24) = " Eds5"
atitoli(25) = " "
atitoli(26) = " EqC10"
atitoli(27) = " EqU>C"
atitoli(28) = " "
atitoli(29) = " Edtt1"
atitoli(30) = " Edtt2"
atitoli(31) = " Edtt3"
atitoli(32) = " Edtt4"
atitoli(33) = " Edtt5"
atitoli(34) = " "
atitoli(35) = " 2CPrec "
atitoli(36) = " Cons>9 "
atitoli(37) = " Cons<9 "
' inizializzo la tabella
SetTableWidth("90%px")
Call InitTabella(atitoli,2,"center",1.3,5,"Arial")
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in Single
If svi = "S" Or svi = "s" Then
'loop 90 numeri x abbinamento al capogioco
For abbin = abbin + 1 To 90
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(1,90,abbin)
If cap <> abbin Then
If ct = 0 Then
nx = 1
combinazione = Format2(cap)
lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli,rttdet)
ct = 1
End If
combinazione = ""
nx = 1
combinazione = Format2(abbin)
lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli,rttdet)
'''' e riepilogo combinazione intera
combinazione = ""
nx = 2
combinazione = Format2(cap) & "-" & Format2(abbin)
lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli,rttdet)
End If
Next
End If
'''''---------------------------------------------------------------------------------------------------------
Call CreaTabella
Scrivi
Scrivi " Ritardo max dei max delle coppie è stato..." & max,1
ColoreTesto(2)
Scrivi " A p p u n t i :",1
Scrivi " Esempio: ultimi 10 ritardi, nr.22 Rit.Att.79 Prec. 13 72 0 05 52 01 04 07 19 0 Max rit.72 Att.79"
Scrivi " Esempio: ultimi 10 ritardi, nr.27 Rit.Att.13 Prec. 13 01 09 14 04 28 27 24 21 0 Max rit.31 Att.13"
Scrivi " il capogioco n.22 ha superato il rit.max negli ult.10 ritardi precedenti e la coppia ha un ritardo att.13 vicino ai 18del cicloTeor."
Scrivi " la coppia quindi deve avere ritardo minore e vicino a 18 x ambata"
Scrivi " La consecutività > di 7 ed il ritardo > 19 è buon indicatore di probabile rottura della coppia",1
Scrivi " La consecutività > di 7 ed il ritardo dell'ambo secco > 1000 è un buon indicatore di rottura della coppia anche per ambo secco",1
ColoreTesto(1)
Scrivi "---------------",1
Scrivi " --- nei 5 campi (edtt1:edtt5) il colore arancio indica che la posizione non è mai uscita negli ultimi 36 concorsi su TUTTE e può essere",1
Scrivi " Utile prendere in considerazione tale numero e tale posizione per un investimento 5 volte quello che si punta entro i 45 del ciclo EST.DET",1
Scrivi " --- nei 5 campi (eds1:eds:5) contiene le presenze reali determinate negli ultimi 900 concorsi",1
Scrivi " tale dato è semplicemente visivo ed indica velocemente quali sono le posizioni determinate più deficitarie ",1
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli,rttdet)
Dim Ritardo,RitardoMax,IncrRitMax,Frequenza,sRetGruppiAnalizz,aRetRitardi,aRetIdEstr,sorte,q,somrit,Totpesd,Inivai,y
Dim cicloini,ultimic,uguali,ciclo,ncicli,rz,id,consec,fu,Inivaic,fx,fx1,consec2,a1p,a2p,a3p,a4p
'''' 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
' ' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(37) '
ReDim ed(90,5),edtt(90,5)
aValori(1) = NomeRuota(r)
If nx = 1 Then
ReDim an(1)
an(1) = Left(combinazione,2)
aValori(2) = an(1)
''''----------------------------------------------------------------------------------------------
''''routine per trovare presenze estratto determinato pos.1-2-3-4-5 nella storia
If diecicicli = "ST" Or diecicli = "st" Then
Totpesd =(fine - Ini)/90
Inivai = Ini
Else
Totpesd = 10
Inivai = fine - 899
End If
aValori(20) = ""
aValori(21) = ""
aValori(22) = ""
aValori(23) = ""
aValori(24) = ""
For Inivai = Inivai + 1 To fine
For y = 1 To 5
If Int(Estratto(Inivai,r,y)) = Int(an(1)) Then
ed(an(1),y) = ed(an(1),y) + 1
End If
Next
Next
If defaul = "S" Or defaul = "s" Then
aValori(20) = ed(an(1),1) - Int(Totpesd)
aValori(21) = ed(an(1),2) - Int(Totpesd)
aValori(22) = ed(an(1),3) - Int(Totpesd)
aValori(23) = ed(an(1),4) - Int(Totpesd)
aValori(24) = ed(an(1),5) - Int(Totpesd)
Else
aValori(20) = ed(an(1),1)
aValori(21) = ed(an(1),2)
aValori(22) = ed(an(1),3)
aValori(23) = ed(an(1),4)
aValori(24) = ed(an(1),5)
End If
''''routine per trovare presenze estratto determinato pos.1-2-3-4-5 nelle ult. 90 estrazione
If rttdet = "TT" Or rttdet = "tt" Then
Inivaic =(fine + 1) -(18*nc)
aValori(29) = ""
aValori(30) = ""
aValori(31) = ""
aValori(32) = ""
aValori(33) = ""
For Inivaic = Inivaic + 1 To fine
For rz = 1 To 10
For y = 1 To 5
If Int(Estratto(Inivaic,rz,y)) = Int(an(1)) Then
edtt(an(1),y) = edtt(an(1),y) + 1
End If
Next
Next
Next
aValori(29) = edtt(an(1),1)
aValori(30) = edtt(an(1),2)
aValori(31) = edtt(an(1),3)
aValori(32) = edtt(an(1),4)
aValori(33) = edtt(an(1),5)
Else
Inivaic =(fine + 1) -(180*nc)
aValori(29) = ""
aValori(30) = ""
aValori(31) = ""
aValori(32) = ""
aValori(33) = ""
For Inivaic = Inivaic + 1 To fine
For y = 1 To 5
If Int(Estratto(Inivaic,r,y)) = Int(an(1)) Then
edtt(an(1),y) = edtt(an(1),y) + 1
End If
Next
Next
aValori(29) = edtt(an(1),1)
aValori(30) = edtt(an(1),2)
aValori(31) = edtt(an(1),3)
aValori(32) = edtt(an(1),4)
aValori(33) = edtt(an(1),5)
End If
''''----------------------------------------------------------------------------------------------
End If
If nx = 2 Then
ReDim an(2)
an(1) = Left(combinazione,2)
an(2) = Right(combinazione,2)
aValori(2) = an(1) & " " & an(2)
''''2 cicli precedenti x i 2 estratti
a1p = EstrattoFrequenza(r,an(1),fine - 18,fine - 1)
a2p = EstrattoFrequenza(r,an(2),fine - 18,fine - 1)
a3p = EstrattoFrequenza(r,an(1),fine - 36,fine - 1)
a4p = EstrattoFrequenza(r,an(2),fine - 36,fine - 1)
aValori(35) = a1p & " " & a2p & " | " & a3p & " " & a4p & " "
''''ricerca valori equilibrio instabile nella coppia (26 cicli totali - ultimi - ritardo att.coppia e max)
cicloini =(fine + 1 - 180)
ncicli = 10
ReDim cic1(50)
ReDim cic2(50)
uguali = 0
ultimic = 0
For ciclo = 1 To ncicli
cic1(ciclo) = EstrattoFrequenza(r,an(1),cicloini,cicloini + 17)
cic2(ciclo) = EstrattoFrequenza(r,an(2),cicloini,cicloini + 17)
cicloini = cicloini + 18
If cic1(ciclo) = cic2(ciclo) Then
uguali = uguali + 1
End If
If ciclo > 4 And cic1(ciclo) = cic2(ciclo) Then
ultimic = ultimic + 1
Else
ultimic = 0
End If
Next
aValori(26) = uguali
aValori(27) = ultimic
End If
sorte = nsorte
art(1) = r
Call StatisticaFormazione(an,art,1,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
aValori(3) = Ritardo
aValori(4) = RitardoMax
aValori(5) = Frequenza
ReDim aRetRitardi(0)
Call ElencoRitardiTurbo(an,art,1,Ini,fine,aRetRitardi,aRetIdEstr)
last10 = UBound(aRetRitardi) - 10
last = UBound(aRetRitardi)
f1 = 0
f = 6
somrit = 0
For f1 = f1 + 1 To 10
aValori(f + f1) = aRetRitardi(last - f1)
somrit = somrit + aRetRitardi(last - f1)
Next
aValori(6) = somrit
If aValori(3) > 0 Then
rapp = aValori(6) / aValori(3)
Else
rapp = 0
End If
' aValori(17) = Round(rapp,1)
If nx = 2 Then
fx = 17
consec = 0
consec2 = 0
For fx1 = 1 To 10
If aValori(fx - fx1) > 9 Then
consec = consec + 1
consec2 = 0
Else
consec2 = consec2 + 1
consec = 0
End If
Next
aValori(36) = consec
aValori(37) = consec2
art(1) = r
Call StatisticaFormazione(an,art,2,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
aValori(18) = Ritardo
art(1) = 11
Call StatisticaFormazione(an,art,2,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
aValori(19) = Ritardo
Else
aValori(18) = ""
aValori(19) = ""
End If
aValori(17) = " "
aValori(25) = " "
aValori(28) = " "
Call AddRigaTabella(aValori,Bianco_,"center",1)
Call SetColoreCella(6,RGB(214,214,214),vbBlack)
Call SetColoreCella(20,RGB(217,255,255),vbBlack)
Call SetColoreCella(21,RGB(217,255,255),vbBlack)
Call SetColoreCella(22,RGB(217,255,255),vbBlack)
Call SetColoreCella(23,RGB(217,255,255),vbBlack)
Call SetColoreCella(24,RGB(217,255,255),vbBlack)
Call SetColoreCella(29,RGB(217,255,255),vbBlack)
Call SetColoreCella(30,RGB(217,255,255),vbBlack)
Call SetColoreCella(31,RGB(217,255,255),vbBlack)
Call SetColoreCella(32,RGB(217,255,255),vbBlack)
Call SetColoreCella(33,RGB(217,255,255),vbBlack)
Call SetColoreCella(34,RGB(0,4,164),vbBlack)
Call SetColoreCella(25,RGB(0,4,164),vbBlack)
Call SetColoreCella(28,RGB(0,4,164),vbBlack)
Call SetColoreCella(17,RGB(0,4,164),vbBlack)
If aValori(20) < - 10 Or aValori(20) > 10 Then
Call SetColoreCella(20,RGB(1,147,158),vbWhite)
End If
If aValori(21) < - 10 Or aValori(21) > 10 Then
Call SetColoreCella(21,RGB(1,147,158),vbWhite)
End If
If aValori(22) < - 10 Or aValori(22) > 10 Then
Call SetColoreCella(22,RGB(1,147,158),vbWhite)
End If
If aValori(23) < - 10 Or aValori(23) > 10 Then
Call SetColoreCella(23,RGB(1,147,158),vbWhite)
End If
If aValori(24) < - 10 Or aValori(24) > 10 Then
Call SetColoreCella(24,RGB(1,147,158),vbWhite)
End If
If nx = 2 Then
For fo = 1 To 5
Call SetColoreCella(Int(fo),RGB(244,202,34),vbBlack)
Call SetColoreCella(Int(fo) + 19,RGB(244,202,34),vbBlack)
Call SetColoreCella(Int(fo) + 28,RGB(244,202,34),vbBlack)
Next
If aValori(18) > 1000 Then
Call SetColoreCella(18,RGB(244,202,34),vbBlack)
End If
If aValori(4) > max Then
max = aValori(4)
End If
If aValori(3) >= aValori(4) - 6 Then
Call SetColoreCella(3,RGB(233,108,86),vbWhite)
Call SetColoreCella(4,RGB(233,108,86),vbWhite)
For fo = 7 To 16
If aValori(fo) > 9 Then
Call SetColoreCella(Int(fo),RGB(233,108,86),vbWhite)
End If
Next
End If
If aValori(37) = 10 Then
Call SetColoreCella(37,RGB(219,85,40),vbWhite)
For fo = 7 To 16
Call SetColoreCella(Int(fo),RGB(219,85,40),vbWhite)
Next
End If
If aValori(3) > 15 And aValori(3) < 19 And aValori(19) > 19 And aValori(19) < 85 Then
Call SetColoreCella(3,RGB(80,253,30),vbBlack)
Call SetColoreCella(19,RGB(80,253,30),vbBlack)
End If
If aValori(27) > 3 Then
Call SetColoreCella(27,RGB(1,147,158),vbWhite)
End If
If aValori(36) > 5 Then
Call SetColoreCella(17,RGB(252,38,7),vbWhite)
End If
If aValori(36) > 8 Then
For fo = 7 To 16
Call SetColoreCella(Int(fo),RGB(252,38,7),vbWhite)
Next
End If
If aValori(37) > 6 And aValori(3) > 5 And aValori(18) > 1000 And aValori(37) > 6 And aValori(3) < 30 And aValori(18) > 1000 Then
Call SetColoreCella(37,RGB(233,74,29),vbWhite)
Call SetColoreCella(18,RGB(233,74,29),vbWhite)
Call SetColoreCella(2,RGB(233,74,29),vbWhite)
Call SetColoreCella(3,RGB(233,74,29),vbWhite)
End If
End If
If nx = 1 Then
For fo = 7 To 16
If aValori(fo) > 17 Then
Call SetColoreCella(Int(fo),RGB(147,210,125),vbBlack)
Else
Call SetColoreCella(Int(fo),RGB(188,255,159),vbBlack)
End If
Next
If aValori(3) > 17 Then
Call SetColoreCella(3,RGB(187,205,167),vbBlue)
End If
If aValori(3) >= aValori(4) - 6 Then
Call SetColoreCella(3,RGB(233,108,86),vbWhite)
Call SetColoreCella(4,RGB(233,108,86),vbWhite)
End If
For id = 29 To 33
If aValori(id) = 0 Then
Call SetColoreCella(Int(id),RGB(233,108,86),vbWhite)
End If
Next
End If
'
GetRitardi = Lancia
End Function
''''------------------------------------------------------------------------------------------------------------------
