| 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
|