Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
=================================Ilegend si potrebbe avere il tabellone per singola ruota con quantità teorica e quantità reale .
ciao Eugenio
| |||||||||
SPMT vers. 1.6.34_Agg.Web e relativo plugin SVP vers. 1.0.56 e Plugin_FTP vers. 1.0 e SpazioScript vers.1.0.9 | |||||||||
====================== | |||||||||
Ciao genios , | |||||||||
====================== | |||||||||
in attesa che risponda il bravo iLegend | |||||||||
e controlla le piccole modifiche che ho fatto io al suo script, | |||||||||
prova questo su UNA RUOTA ( lo avevo fatto per me) :
Codice:
|
Option Explicit
' NON SI GARANTISCE CHE I DATI RIPORTATI SIANO ESATTI
' CHI L UTILIZZA LO FA SOTTO LA PROPRIA RESPONSABILITA
Sub Main
If MessaggioInfo = False Then Exit Sub
Dim aColRibb
Dim PiuRitRu,RitRu,MaxRitTT,Ub
ReDim aRuVer(0) ' scelgo le ruote su cui effettuare le analisi
Call ScegliMyRuote(aRuVer)
Ub = UBound(aRuVer) :If Ub < 1 Then Exit Sub
ReDim aRit(Ub,2)
ReDim aNumEstr(Ub,90)
Call ResetTimer
Call GetMaxRitTab(aRuVer,aRit,PiuRitRu,RitRu,MaxRitTT)
aColRibb = RGB(236,235,246)
Dim spTit:If Ub = 11 Then spTit = 195 : Else spTit = 194
Scrivi FormatSpace(" Numeri più ritardatari per ruota ( NON SI GARANTISCE CHE I DATI RIPORTATI SIANO ESATTI, CHI L UTILIZZA LO FA SOTTO LA PROPRIA RESPONSABILITA)",spTit),1,,RGB(40,148,255),vbWhite,2.5
Call SetColorSezione(aColRibb)
If Ub <= 6 Then
Call GetRibbonPiuRitardatari(aColRibb,aRuVer,1,Ub,aRit,PiuRitRu,RitRu,MaxRitTT)
Else
Call GetRibbonPiuRitardatari(aColRibb,aRuVer,1,6,aRit,PiuRitRu,RitRu,MaxRitTT)
Call GetRibbonPiuRitardatari(aColRibb,aRuVer,7,Ub,aRit,PiuRitRu,RitRu,MaxRitTT)
End If
Call SetColorSezione(RGB(255,255,245))
'
Call GetTestoTab(aRuVer)
Call GetOutPutTabelloneAnalitico(Ub,aRuVer,MaxRitTT,aRit)
Call GetTestoTab(aRuVer)
Scrivi " Elaborato in : " & TempoTrascorso,1,,,RGB(128,0,0)
End Sub
Function MessaggioInfo()
MessaggioInfo = True
Dim Quest
Quest = MsgBox("Verificare che i dati riportati siano esatti" & vbCrLf & "Non se ne garantisce la correttezza" & vbCrLf & " NON MODIFICARE DA SE I PARAMETRI" & vbCrLf & "Vuoi proseguire?",4 + 64,"Informazioni versione beta 0_1")
If Quest = 7 Then MessaggioInfo = False
End Function
Sub ScegliMyRuote(aRuVer)
ReDim aVoci(10)
ReDim aVociSel(10)
Dim k,m
For k = 0 To 10
m = m + 1
If m = 11 Then m = 12
aVoci(k) = NomeRuota(m)
Next
m = 0
If ScegliDaLista(aVoci,aVociSel,"Seleziona Ruota/e di Verifica") >= 0 Then
For k = 0 To UBound(aVoci)
If aVociSel(k) Then
m = m + 1
ReDim Preserve aRuVer(m)
aRuVer(m) = k + 1
If aRuVer(m) = 11 Then aRuVer(m) = 12
End If
Next
End If
End Sub
Sub GetMaxRitTab(aRuVer,aRit,NumPiuRit,RitRu,MaxRitTT)
Dim R
MaxRitTT = 0
For R = 1 To UBound(aRuVer)
NumPiuRit = PiuRitardatarioTurbo(EstrazioneFin,aRuVer(R))
RitRu = EstrattoRitardoTurbo(aRuVer(R),NumPiuRit,EstrazioneFin - 350,EstrazioneFin)
aRit(R,1) = NumPiuRit
aRit(R,2) = RitRu
If MaxRitTT < RitRu Then MaxRitTT = RitRu
Next
End Sub
Sub GetRibbonPiuRitardatari(acolrib,aRuVer,Lb,Ub,aRit,NumPiuRit,RitRu,MaxRitTT)
Dim i,R,Ucs,k
Dim aCol(2),aColRu(2),aColNu(2),aColTit(2)
Scrivi Space(1),,0,,,4
k = 0
For i = Lb To Ub
k = k + 2
If pari(i) Then
aColTit(1) =(RGB(140,140,198) - k*7)
aColTit(2) =(RGB(241,241,248) - k*7)
Else
aColTit(1) = RGB(153,193,30) - k*7
aColTit(2) = RGB(255,255,255) - k*7
End If
Scrivi " " & FormatSpace("Ruota",10) & " ",1,0,aColTit(1),aColTit(2)
Scrivi " ",,0,acolrib
Scrivi " " & FormatSpace("Estr",4) & " ",1,0,aColTit(1),aColTit(2)
Scrivi " ",,0,acolrib
Scrivi " " & FormatSpace("RcMx",4) & " ",1,0,aColTit(1),aColTit(2)
Scrivi " ",,0,acolrib
Next
Scrivi
Scrivi Space(1),,0,,,4
For R = Lb To Ub
If aRit(R,2) <> MaxRitTT Then
Ucs = 0
aCol(1) = RGB(255,255,255)
aCol(2) = RGB(250,37,96)
aColRu(1) = RGB(255,255,255)
aColRu(2) = RGB(0,64,128)
aColNu(1) = RGB(255,255,245)
aColNu(2) = RGB(0,64,0)
Else
Ucs = 1
aCol(1) = RGB(250,37,96)
aCol(2) = RGB(255,255,255)
aColRu(1) = aCol(1)
aColRu(2) = aCol(2)
aColNu(1) = aCol(1)
aColNu(2) = aCol(2)
End If
Scrivi " " & FormatSpace(NomeRuota(aRuVer(R)),10) & " ",Ucs,0,aColRu(1),aColRu(2)
Scrivi " ",,0,acolrib
Scrivi " " & FormatSpace(aRit(R,1),4,1) & " ",Ucs,0,aColNu(1),aColNu(2)
Scrivi " ",,0,acolrib
Scrivi " " & FormatSpace(aRit(R,2),4,1) & " ",Ucs,0,aCol(1),aCol(2)
Scrivi " ",,0,acolrib
Next
Scrivi
Scrivi
End Sub
Sub GetTestoTab(aRuVer)
Dim R,p
Scrivi " | |",,0,RGB(236,235,247)
For R = 1 To UBound(aRuVer)
Scrivi Space(14) & "|",,0,RGB(236,235,247)
Next
Scrivi " ",,,RGB(254,248,182)
Scrivi "CONC|R.C|",,0,RGB(235,234,244)
For R = 1 To UBound(aRuVer)
Scrivi Space(6) & SiglaRuota(aRuVer(R)) & Space(6) & "|",,0,RGB(235,234,244)
Next
Scrivi " Q.N | Q.T | SCT ",,,RGB(254,247,158)
Scrivi " | |",,0,RGB(234,233,241)
For R = 1 To UBound(aRuVer)
Scrivi Space(14) & "|",,0,RGB(234,233,241)
Next
Scrivi " ",,,RGB(254,245,139)
End Sub
Sub GetOutPutTabelloneAnalitico(ub,aRuVer,MaxRitTT,aRit)
ReDim aNum(ub,90)
Dim IdEstr,nRigo,R,Pres,m,qt,Se,nEstr,p,E,qNr,sca
Dim scaLim
Dim aColC(2)
Dim Ini:Ini = EstrazioneFin - MaxRitTT
nRigo = - 1
For IdEstr = EstrazioneFin To Ini Step - 1
nRigo = nRigo + 1
Scrivi IdEstr,1,0,RGB(235,235,255)
Scrivi "|",,0,vbWhite,RGB(89,89,89)
Scrivi FormattaStringa(nRigo,"000"),,0,RGB(237,254,205),RGB(128,0,0)
Scrivi "|",1,0,vbWhite,,3
Pres = 0:m = 0
qt = Round(QuantitaTeoricaCombAlRitX(nRigo),5)
For R = 1 To ub
If dispari(R) Then aColC(1) = vbWhite:aColC(2) = RGB(0,101,149):Else aColC(1) = vbWhite:aColC(2) = RGB(38,40,37)
m = m + 1
Se = "":nEstr = 0
For p = 1 To 5
E = Estratto(IdEstr,aRuVer(R),p)
' metodo raccolta numeri di Joe91
If aNum(R,E) = 0 Then
' cekko i numeri appena estratti e non li riutilizzo nell output
aNum(R,E) = 1
E = Format2(E)
Pres = Pres + 1 ' PRESENZE TOTALI RUOTE
nEstr = nEstr + 1 ' NUMERI PRESENTI NELLA RUOTA SINGOLA
Else
E = ".."
End If
Se = Se & E & " "
Next
Se = RimuoviLastChr(Se," ")
If nEstr > qt And nRigo <> aRit(R,2) Then
aColC(1) = RGB(209,209,236)
ElseIf nRigo = aRit(R,2) Then
aColC(1) = RGB(255,196,196)
End If
Scrivi Se,,0,aColC(1),aColC(2)
Scrivi "|",,0,vbWhite,RGB(89,89,89)
Next
qNr = Round(qt*ub,3)
sca = Round(Pres - qNr,2)
If sca > 0 Then sca = "+" & sca
Scrivi " " & Format2(Pres) & " ",1,0,RGB(211,250,245)
Scrivi "|",,0
Scrivi FormatSpace(qNr,6,1) & " ",,0,RGB(255,217,217)
Scrivi "|",,0
If sca < 0 Then
Scrivi FormatSpace(sca,5,1),,,RGB(255,117,117),vbWhite
ElseIf sca >= 0 And sca <= 3 Then
Scrivi FormatSpace(sca,5,1),,,RGB(171,171,214),vbWhite
Else
Scrivi FormatSpace(sca,5,1),1,,RGB(145,223,147)
End If
Next
End Sub
Grazie tom
Se l utilizzi o fai qualche pro a dimmi se funzia per favore .
Notte a tutti
Vedi l'allegato 2199293
tom è questo il tab che ti risultava?
Ciao AlienOttimo ma come si può usare per un pronostico ?
Si potrebbe evidenziare gli stessi numeri uguali dall'estrazione 1 fino indietro
ad un certo punto si trovano 3/5/7 ecc numeri uguali usciti in 2 o più ruote e mettere in gioco quelli e vediamo cosa succede ? che se pò fà.
SPMT vers. 1.6.34_Agg.Web e relativo plugin SVP vers. 1.0.56 e Plugin_FTP vers. 1.0 e SpazioScript vers.1.0.9 |
====================== |
Ciao ilegend , |
====================== |
provato tutto OK |
ottimo, grazie. |
====================== |
Buona giornata a tutto il forum. |
====================== |
A presto |
Silop |
Ottimo ma come si può usare per un pronostico ?
Si potrebbe evidenziare gli stessi numeri uguali dall'estrazione 1 fino indietro
ad un certo punto si trovano 3/5/7 ecc numeri uguali usciti in 2 o più ruote e mettere in gioco quelli e vediamo cosa succede ? che se pò fà.
Un es. di utilizzo potrebbe essere quello che hai detto alien.
Oppure io provo per adesso a monitorare i valori di scarto maggiori... prediligendo teoricamente condizioni di isocronia o isofrequenza eventuali... per identificare possibili micro lunghette x p1 o superiori ecc... Anche questa ennesima chicca del grandissimo ilegend in sostanza può tornare utile in mille e uno modi