| CITAZIONE (silop2005 @ 31/3/2021, 18:04)  SPMT vers. 1.6.34_Agg.Web e relativo plugin SVP vers. 1.0.56 e Plugin_FTP vers. 1.0 e SpazioScript vs.1.0.9 e RicercaLunghetta vers.1.0.31 e LottoOpen v.1.0.56======================= Ciao i Legend , ====================== riporto qui, il contenuto del mio post dal thread di Genal, e continuiamo il discorso sulle Prime Righe VUOTE [1^Rv] o [L0]. ------------------------------------------------ inizio riporto post mio ------------------------ ho visto il bellissimo script che hai fatto sulle indicazioni del bravo Genal e Gam, ti vorrei chiedere, se possibile, fare lo stesso script con le stesse modalità (lo stesso impianto) al posto dei residui [L1] del sincronone originario sulle 11 ruote, si devono elaborare tutte le Prime Righe VUOTE [1^Rv] o [L0] che sono in sincronismo con lo stesso [RC] sulle 11 ruote cioè che si trovano sulla stessa linea orizzontale del ritardo. Per farmi capire cosa intendo, ti metto tre immagini la prima del tabellone intero alla 9902 delle 11 ruote preso dal programma " LottoOpen" by LuigiB, evidenziati con colori uguali i livelli [L0] che hanno lo stesso RC uguale che sono in sincronismo poi le altre due la 9902 e la 9904 ti evidenzio SOLO LA PARTE BASSA del tabellone e tutto quello che sta al di sotto della [1^Rv] Prima Riga VUOTA di ogni ruota e la parte che mi interessa di più. Vedi immagini =====================   ===================== ====================== continua …. Credo che sia sufficiente, come hai fatto per gli [L1], la fotografia del momento (attuale) del tabellone e stampi per ogni ruota i valori sincroni CONVERGENTI degli [L0] o [1^Rv] insieme agli [RC]. Esempio reale alla 9902 vedi tabellone : [1^Rv] - MI - RSL: ( 001) Rc:[022] [1^Rv] - PA - RSL: ( 011) Rc:[022] [1^Rv] - TO - RSL: ( 001) Rc:[022] e poi ancora [1^Rv] - CA - RSL: ( 000) Rc:[013] [1^Rv] - F I - RSL: ( 000) Rc:[013] [1^Rv] - NA - RSL: ( 005) Rc:[013] =====================  ===================== continua…. Esempio reale alla successiva estrazione alla 9904 vedi tabellone : [1^Rv] - MI - RSL: ( 003) Rc:[024] [1^Rv] - TO - RSL: ( 003) Rc:[024] La [1^Rv] di PA nel frattempo è scomparsa perché è subentrata la NUOVA [1^Rv] - PA - RSL: ( 000) Rc:[021] la quale non sta più in sincronismo con altre ruote. poi ancora alla 9904 : [1^Rv] - CA - RSL: ( 002) Rc:[015] [1^Rv] - F I - RSL: ( 002) Rc:[015] [1^Rv] - NA - RSL: ( 007) Rc:[015] queste tre sono ancora in sincronismo tra di loro allo stesso RC=15. =====================  ===================== Nella attesa che si possa modificare il suddetto script o farlo ex-novo ti aguro una buona giornata. ------------------------------------------------ FINE riporto post mio ------------------------ ===================== Come ho scritto… Servono solo i dati delle Prime Righe VUOTE di ogni ruota tipo come hai fatto per gli [L1] solitari. Il tabellone me lo faccio con il programma LottoOpen. Buona dormita. ===================== Buon mercoledì a tutto il forum. ====================== A presto Silop  ciao Silop come da te richiesto ecco i due script . per favore verifica che i risultati siano corretti se fai copia incolla poi in un foglio di calcolo si dovrebbero incolonnare bene non ho excel quindi non ho potuto verificare su questo software. script 1 L0 ALLO STESSO rc CONTROLLARE SE rC E rsl SIANO ESATTI CODICE Option Explicit
Sub Main
Dim s,i
s = "GLI UTENTI-UTILIZZATORI SARANNO GLI UNICI RESPONSABILI DI QUALSIASI TIPO DI EVENTUALI DANNI DERIVANTI DALL UTILIZZO DEL SUDDETTO LISTATO " & vbCrLf & _
"L ' AUTORE DEL LISTATO NON GARANTISCE LA CORRETTEZZA O LA COMPLETEZZA DEI DATI RIPORTATI" & vbCrLf & _
"IL LISTATO VIENE DONATO GRATUITAMENTE " & vbCrLf & _
"E'SEVERAMENTE VIETATA LA VENDITA DI QUESTO LISTATO"
i = MsgBox(s,4,"SE DECIDI NON DIPROSEGUIRE NELLA VISUALIZZAZIONE DEI DATI SCEGLI NO ")
If i = 7 Then Exit Sub
Dim idEstrFinAnaliz: idEstrFinAnaliz = EstrazioneFin
Dim IdEstr,Rit,aSinc,nRuota,StrCinqEstr,StrSincDiLiv,nRSL,nLiv
Dim k
Dim sep:sep = ";"
Dim nRitAnaliz:nRitAnaliz = 50
Dim nRuo
Dim aNewOrdRuo:aNewOrdRuo = Array(0,1,2,3,4,5,6,7,8,9,10,12)
Scrivi "Conc;Rit;BAliv;RSL;CAliv;RSL;FIliv;RSL;GEliv;RSL;MIliv;RSL;NAliv;RSL;PAliv;RSL;ROliv;RSL;TOliv;RSL;VEliv;RSL;NZliv;RSL;QL0"
Rit = 0
For IdEstr = idEstrFinAnaliz To 1 Step - 1
s = ""
k = 0
Scrivi FormattaStringa(IdEstr,"0000") & ";" & FormattaStringa(Rit,"000") & ";",0,0
For nRuota = 1 To UBound(aNewOrdRuo)
nRuo = aNewOrdRuo(nRuota)
'If nRuota=11 Then nRuota=12
Call GetInfoRigaTabIdFin_Estr_Analiz(idEstrFinAnaliz,IdEstr,aSinc,nRuo,StrCinqEstr,StrSincDiLiv,nRSL,nLiv)
If nLiv = 0 Then
k = k + 1: 'If k = 10 Then Exit For
s = s & "L0;" & nRSL & ";"
Else
s = s & ";;"
End If
Next
Scrivi s & k
Rit = Rit + 1
If k = 11 Then Exit For
Next
End Sub
Sub GetInfoRigaTabIdFin_Estr_Analiz(idEstrFinAnaliz,IdEstr,aSinc,nRuota,StrCinqEstr,StrSincDiLiv,nRSL,nLiv)
Dim aR(1),aN(1)
Dim nElem :If nRuota = 11 Then nElem = 50 Else nElem = 5
ReDim aSinc(nElem)
Dim idTemp,idPrima
Dim R,p,m
aR(1) = nRuota
Dim aRuotaTemp(1)
StrCinqEstr = ""
StrSincDiLiv = ""
' in base alla ruota selezionata ottengo i dati
' se la ruota è tutte considero gli elementi tutti insieme nella ruota di ultima caduta
If nRuota = 11 Then
nLiv = 0
idTemp = 0
m = 0
For R = 1 To 10
aRuotaTemp(1) = R
For p = 1 To 5
m = m + 1
aN(1) = Estratto(IdEstr,aRuotaTemp(1),p)
StrCinqEstr = StrCinqEstr & Format2(aN(1)) & " "
If SerieUltima(IdEstr,idEstrFinAnaliz,aN,aR,1) = IdEstr Then
nLiv = nLiv + 1
aSinc(m) = Format2(aN(1))
StrSincDiLiv = StrSincDiLiv & Format2(aN(1)) & " "
Else
aSinc(m) = "--"
StrSincDiLiv = StrSincDiLiv & "--" & " "
idPrima = SeriePrima(IdEstr + 1,idEstrFinAnaliz,aN,aR,1)
If idTemp < idPrima Then idTemp = idPrima
End If
Next
StrSincDiLiv = StrSincDiLiv & "|"
StrCinqEstr = StrCinqEstr & "|"
Next
Else
Dim aE
Call GetArrayNumeriRuota(IdEstr,aR(1),aE)
' se gli estratti non erano presenti al concorso
If UBound(aE) = 0 Then
nRSL = 0
nLiv = 0
For p = 1 To 5
aSinc(p) = "--"
Next
StrCinqEstr = StringaNumeri(aSinc," ")
Exit Sub
Else
' eseguo i calcoli
StrCinqEstr = StringaNumeri(aE," ",True)
nLiv = 0
idTemp = 0
For p = 1 To 5
aN(1) = aE(p)
If SerieUltima(IdEstr,idEstrFinAnaliz,aN,aR,1) = IdEstr Then
nLiv = nLiv + 1
aSinc(p) = aN(1)
Else
aSinc(p) = "--"
idPrima = SeriePrima(IdEstr + 1,idEstrFinAnaliz,aN,aR,1)
If idTemp < idPrima Then idTemp = idPrima
End If
Next
End If
StrSincDiLiv = StringaNumeri(aSinc," ",True)
End If
If idTemp = 0 Then idTemp = IdEstr
nRSL = idEstrFinAnaliz - idTemp'
End Sub CODICE Option Explicit
Sub Main
Dim s,i
s = "GLI UTENTI-UTILIZZATORI SARANNO GLI UNICI RESPONSABILI DI QUALSIASI TIPO DI EVENTUALI DANNI DERIVANTI DALL UTILIZZO DEL SUDDETTO LISTATO " & vbCrLf & _
"L ' AUTORE DEL LISTATO NON GARANTISCE LA CORRETTEZZA O LA COMPLETEZZA DEI DATI RIPORTATI" & vbCrLf & _
"IL LISTATO VIENE DONATO GRATUITAMENTE " & vbCrLf & _
"E'SEVERAMENTE VIETATA LA VENDITA DI QUESTO LISTATO"
i = MsgBox(s,4,"SE DECIDI NON DIPROSEGUIRE NELLA VISUALIZZAZIONE DEI DATI SCEGLI NO ")
If i = 7 Then Exit Sub
Dim idEstrFinAnaliz: idEstrFinAnaliz = EstrazioneFin
Dim IdEstr,Rit,aSinc,nRuota,StrCinqEstr,StrSincDiLiv,nRSL,nLiv
Dim qTeoLiv,ScaLiv
Dim sep:sep = ";"
Dim nRitAnaliz:nRitAnaliz = 50
Dim nRuo
Dim aNewOrdRuo:aNewOrdRuo = Array(0,1,2,3,4,5,6,7,8,9,10,12)
Scrivi "Ruota;Conc;RC;ESTRATTI;SINCRONI;LIV;qTeoLiv;ScaLiv;RSL"
For nRuota = 1 To UBound(aNewOrdRuo)
nRuo = aNewOrdRuo(nRuota)
Rit = 0
For IdEstr = idEstrFinAnaliz To 1 Step - 1
qTeoLiv = Round(QuantitaTeoricaCombAlRitX(Rit,1,1),3)
Call GetInfoRigaTabIdFin_Estr_Analiz(idEstrFinAnaliz,IdEstr,aSinc,nRuo,StrCinqEstr,StrSincDiLiv,nRSL,nLiv)
If nLiv <= 2 Then
ScaLiv = qTeoLiv - nLiv
Scrivi SiglaRuota(nRuo) & sep & IdEstr & sep & Rit & sep & StrCinqEstr & sep & StrSincDiLiv & sep & "L" & nLiv & sep & qTeoLiv & sep & ScaLiv & sep & nRSL
End If
Rit = Rit + 1
If Rit > nRitAnaliz Then Exit For
If nLiv = 0 Then Exit For
If ScriptInterrotto Then Exit For
Next 'IdEstr
Next
Scrivi
End Sub
Sub GetInfoRigaTabIdFin_Estr_Analiz(idEstrFinAnaliz,IdEstr,aSinc,nRuota,StrCinqEstr,StrSincDiLiv,nRSL,nLiv)
Dim aR(1),aN(1)
Dim nElem :If nRuota = 11 Then nElem = 50 Else nElem = 5
ReDim aSinc(nElem)
Dim idTemp,idPrima
Dim R,p,m
aR(1) = nRuota
Dim aRuotaTemp(1)
StrCinqEstr = ""
StrSincDiLiv = ""
' in base alla ruota selezionata ottengo i dati
' se la ruota è tutte considero gli elementi tutti insieme nella ruota di ultima caduta
If nRuota = 11 Then
nLiv = 0
idTemp = 0
m = 0
For R = 1 To 10
aRuotaTemp(1) = R
For p = 1 To 5
m = m + 1
aN(1) = Estratto(IdEstr,aRuotaTemp(1),p)
StrCinqEstr = StrCinqEstr & Format2(aN(1)) & " "
If SerieUltima(IdEstr,idEstrFinAnaliz,aN,aR,1) = IdEstr Then
nLiv = nLiv + 1
aSinc(m) = Format2(aN(1))
StrSincDiLiv = StrSincDiLiv & Format2(aN(1)) & " "
Else
aSinc(m) = "--"
StrSincDiLiv = StrSincDiLiv & "--" & " "
idPrima = SeriePrima(IdEstr + 1,idEstrFinAnaliz,aN,aR,1)
If idTemp < idPrima Then idTemp = idPrima
End If
Next
StrSincDiLiv = StrSincDiLiv & "|"
StrCinqEstr = StrCinqEstr & "|"
Next
Else
Dim aE
Call GetArrayNumeriRuota(IdEstr,aR(1),aE)
' se gli estratti non erano presenti al concorso
If UBound(aE) = 0 Then
nRSL = 0
nLiv = 0
For p = 1 To 5
aSinc(p) = "--"
Next
StrCinqEstr = StringaNumeri(aSinc," ")
Exit Sub
Else
' eseguo i calcoli
StrCinqEstr = StringaNumeri(aE," ",True)
nLiv = 0
idTemp = 0
For p = 1 To 5
aN(1) = aE(p)
If SerieUltima(IdEstr,idEstrFinAnaliz,aN,aR,1) = IdEstr Then
nLiv = nLiv + 1
aSinc(p) = aN(1)
Else
aSinc(p) = "--"
idPrima = SeriePrima(IdEstr + 1,idEstrFinAnaliz,aN,aR,1)
If idTemp < idPrima Then idTemp = idPrima
End If
Next
End If
StrSincDiLiv = StringaNumeri(aSinc," ",True)
End If
If idTemp = 0 Then idTemp = IdEstr
nRSL = idEstrFinAnaliz - idTemp'
End Sub |
