Option Explicit
Sub Main()
'https://forum.lottoced.com/threads/spaziometria-formazioni-multiple.2193770/page-2#post-2231788
'0901_27 Rosanna Biambi in figura, con maggior ritardo
'Tradotto ed adattato per Spazionmetria calcola Biambi in Differenza
' V.3.1 del 07/04/2020 By Joe
' Aggiunto calcolo Biambo a Tutte
'Riferimenti statistici agg. al 21/03/2020:
'Ro_ Diff 40 Biambo 19.59 ; 50.90 rit. 2522
'Ve_ Diff 60 Biambo 17.77 ; 23.83 rit. 2424
'Pa_ Diff 12 Biambo 35.47 ; 50.62 rit. 2440
'Ba_ Diff 15 Biambo 18.33 ; 50.65 rit. 2413
Dim B,C,D,I,J,R,X,Y,Z
Dim Biambo(2,2),Ru(1),Nu(2),Es,Rit1,Rit2,Q
D = CInt(InputBox("Quale vuoi ?","DIFFERENZA nei BIAMBI",40))
X = CInt(InputBox("Quanti ne vuoi visualizzare ?","QUANTITA' BIAMBI",10))
Q = CInt(InputBox("Quanti ne vuoi visualizzare ?","ULTIMI RITARDI",10))
Scrivi Space(10) & " RIEPILOGO BIAMBI IN DISTANZA " & D & " CON MAGGIOR RITARDO " & Chr(10),1
ReDim ambi(90 - D,2)
Es = EstrazioneFin
ReDim Ris(Q)
'---------------------------- SELEZIONO GLI AMBI DELLA DISTANZA DESIDERATA
For I = 1 To 89
For Y = I + 1 To 90
If Abs(I - Y) = D Then
C = C + 1
ambi(C,1) = I
ambi(C,2) = Y
End If
Next ' Y
Next ' I
Scrivi Space(8) & "- Biambo - Rit.C ",1,0
For R = 2 To Q : Scrivi R & "°Rit ",1,0 : Next : Scrivi
'---------------------------- SCORRO LE RUOTE
For R = 1 To 12
Ru(1) = R
AvanzamentoElab 1,12,R
'-----------------------------------AZZERAMENTO / PREPARAZIONE VARIABILI
B = 0 :
ReDim Stat(C*(C - 1)/2,5) ' --------DIMENSIONE DINAMICA COMBINAZIONI
If X > C*(C - 1) / 2 Then X = C*(C - 1)/ 2 'RIDUCE N° FORMAZIONI/ERRORI
'---------------------------------------- CREO I BIAMBI
For I = 1 To(90 - D - 1)
For J = I + 1 To(90 - D)
'-------------- PROCEDO COL MEMORIZZARLI SULLA MATRICE STAT
'-------------- CALCOLO DEL RITARDO (MINIMO/ATTUALE)
B = B + 1
Stat(B,1) = ambi(I,1)
Stat(B,2) = ambi(I,2)
Stat(B,3) = ambi(J,1)
Stat(B,4) = ambi(J,2)
Biambo(1,1) = ambi(I,1)
Biambo(1,2) = ambi(I,2)
Biambo(2,1) = ambi(J,1)
Biambo(2,2) = ambi(J,2)
Call Elenco_Ritardi(Es,R,ambi(I,1),ambi(I,2),ambi(J,1),ambi(J,2),1,Ris)
Stat(B,5) = Ris(1)
Next ' I
Next ' J
Scrivi Space(4) & SiglaRuota(R) & " " & String(11 + 6*Q,"-"),1
OrdinaMatrice Stat,- 1,5 '----------- ORDINO DECRESCENTE STAT SULLA COLONNA RITARDO
For I = 1 To X '--------------------- SCRIVO IN OUTPUT SOLO I BIAMBI DESIDERATI
Scrivi Space(7) & Format2(Stat(I,1)) & "." & Format2(Stat(I,2)) & ";",0,0
Scrivi Format2(Stat(I,3)) & "." & Format2(Stat(I,4)),0,0
Call Elenco_Ritardi(Es,R,Stat(I,1),Stat(I,2),Stat(I,3),Stat(I,4),Q,Ris)
For Z = 1 To Q
If Ris(Z) < 0 Then Ris(Z) = 0 ': ColoreTesto 2
Scrivi FormatSpace(Ris(Z),6,True),0,0 ': ColoreTesto 0
Next : Scrivi' Z
Next ' I
Next ' chiude r
End Sub
Sub Elenco_Ritardi(Es,R,A,B,C,D,Q,Ris)
ReDim Ris(Q)
Dim E,K,Rit,F,T,Rk,Rmin,Rmax
Rmin = 1 : Rmax = 10
If R <> 11 Then Rmin = R : Rmax = R
For E = Es To 1 Step - 1
Rit = Rit + 1
T = 1
For Rk = Rmin To Rmax
If SommaEstratti(E,Rk) = 0 Then E = 1 : Exit For
F = False
If Posizione(E,Rk,A) > 0 And Posizione(E,Rk,B) Then F = True
If Posizione(E,Rk,C) > 0 And Posizione(E,Rk,D) Then F = True
If F = True Then
K = K + T : T = 0
Ris(K) = Rit - 1
Rit = 0
End If
Next
If K >= Q Then Exit For
Next
End Sub
Biambi in differenza con gli ultimi ritardi ordinati). Non trovo l’aggettivo giusto per qualificare le tue capacità professionali in merito, mi sono chiesto, ma come fai !!!. Ho confrontato in diversi modi i risultati che risultano immancabilmente precisi. Sono particolarmente soddisfatto dato che lo script dà la possibilità di variare, sia la lunghezza dei Biambi da esaminare, che la lunghezza degli ultimi ritardi ordinati. Ed inoltre, come ovvio, la possibilità di svariare con le ricerche in qualsiasi periodo delle estrazioni. Fantastico per me, è quello che cercavo da tempo, per abbreviare, approfondire ed arricchire le ricerche in questo campo. Ringrazio anche P. Hetman per il suo intervento.
