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.
Per Rosanna...
- Creatore Discussione miki55
- Data di inizio
L
LuigiB
Guest
bho vabbe fa niente ... ciao
Rosanna
Super Member >PLATINUM<
Se dici a me il listato è completo altrimenti non ti avrei potuto mettere l'output.
Mi aspettavo un commento tipo sì è giusto oppure "questo" (dettaglio) non va... boh
Ecco il listato. E' probabile che tra questa versione e quella di Luigi ci sia spazio almeno per
velocizzare la mia ma al momento sono riuscita a fare solo questo.
ciao
Codice:
Option Explicit
Sub Main
'0904_16b Rosanna listato finale x Miki55
'http://forum.lottoced.com/f12/per-rosanna-106426/
Dim r1,r2,c,ini,ini2,fine1,fine2,es,esf,esff,r,p,n1,n2,i,y
Dim nCasi,nCasiIC,bCorso,nColpo,nMaxRit,bEsito1,bEsito2,nTotR1,nTotR2
Dim aNumR1(5),aNumR2(5)
Dim mRuote(11,2) ' matrice coppia ruote consecutive
ReDim mEsiti(10,0) ' matrice per tutta la casistica conclusa e non
ReDim mStatRit(0,0)' matrice per riversare la casistica dei ritardi x ordinare i rit
ini = 7440 ' <=== attenzione 1° estrazione con la ruota Nazionale
nCasi = 0 'contatore casi
nCasiIC = 0 'contatore casi in corso
nMaxRit = 0
'---------------il seguente blocco serve a creare la matrice delle coppie di ruote
c = 0
For r1 = 1 To 11
If r1 = 11 Then r1 = 12
r2 = r1 + 1
If r1 = 10 Then r2 = 12
If r1 = 12 Then r2 = 1
c = c + 1
mRuote(c,1) = r1 : mRuote(c,2) = r2
Next
'--------------------------------------------- Blocco analisi archivio
For es = ini To EstrazioneFin - 1 ' Escludo l'ultima estrazione di cui non posso cercare gli esiti
AvanzamentoElab ini,EstrazioneFin,es
For r = 1 To 11 ' scorro la MATRICE mRuote delle 11 coppie di ruote
n1 = Estratto(es,mRuote(r,1),5) ' 5° estratto di ciascuna coppia di ruote
n2 = Estratto(es,mRuote(r,2),1) ' 1° estratto di ciascuna coppia di ruote
For p = 1 To 5
aNumR1(p) = Estratto(es,mRuote(r,1),p) 'inizializzo i vettori con gli estratti
aNumR2(p) = Estratto(es,mRuote(r,2),p)
Next
If es + 200 > EstrazioneFin Then fine1 = EstrazioneFin Else fine1 = es + 200
ini2 = 0
For esf = es + 1 To fine1 ' scorro l'archivio per la ricerca del punto in cui i 2 num rimangono soli
For i = 1 To 5 ' scorro i due vettori con i numeri dell'estrazione base
If Posizione(esf,mRuote(r,1),aNumR1(i)) > 0 Then aNumR1(i) = 0 'man mano che si ripresentano i num li azzero sul vettore
If Posizione(esf,mRuote(r,2),aNumR2(i)) > 0 Then aNumR2(i) = 0 'idem per la seconda ruota
Next
nTotR1 = 0 ' variabile che mi serve per controllare la totale sortita gli altri estratti R1
nTotR2 = 0 ' idem c.s. per la ruota 2
If aNumR1(5) > 0 And aNumR2(1) > 0 Then ' se i due num r15°e r21° non sono ancora sortiti
For i = 1 To 4 'ad ogni estrazione ricontrollo se tutti gli altri sono usciti
nTotR1 = nTotR1 + aNumR1(i)
nTotR2 = nTotR2 + aNumR2(i + 1)
Next
If nTotR1 = 0 And nTotR2 = 0 Then ' se tutti gli altri sì i due totali saranno a zero
' per qui da questo punto inizia il controllo dei ritardi e gli esiti
ini2 = esf + 1
If esf + 200 > EstrazioneFin Then fine2 = EstrazioneFin Else fine2 = esf + 200
nCasi = nCasi + 1
nColpo = - 1'inizializzo la variabile per il conteggio dei ritardi
bEsito1 = False
bEsito2 = False 'inizializzo il controllo degli esiti
For esff = ini2 To fine2
nColpo = nColpo + 1 'contatore per il ritardo
If Posizione(esff,mRuote(r,1),n1) > 0 Then
bEsito1 = True
If nColpo > nMaxRit Then nMaxRit = nColpo
ReDim Preserve mEsiti(10,nCasi)
mEsiti(1,nCasi) = es 'Estrazione di rilevamento
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1) '1^ ruota
mEsiti(4,nCasi) = n1 '1° numero
mEsiti(5,nCasi) = mRuote(r,2) '2^ ruota
mEsiti(6,nCasi) = n2 '2°numero
mEsiti(7,nCasi) = n1 '1° numero sortito!
mEsiti(9,nCasi) = nColpo 'ritardo
End If
If Posizione(esff,mRuote(r,2),n2) > 0 Then
bEsito2 = True
If nColpo > nMaxRit Then nMaxRit = nColpo
If bEsito1 = True Then
mEsiti(8,nCasi) = n2 ' 2° numero sortito!
Else
ReDim Preserve mEsiti(10,nCasi)
mEsiti(1,nCasi) = es 'Estrazione di rilevamento
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1)
mEsiti(4,nCasi) = n1
mEsiti(5,nCasi) = mRuote(r,2)
mEsiti(6,nCasi) = n2
mEsiti(8,nCasi) = n2 ' 2° numero sortito!
mEsiti(9,nCasi) = nColpo 'ritardo
End If
End If
If bEsito1 = False And bEsito2 = False And esff = fine2 Then
nCasiIC = nCasiIC + 1
ReDim Preserve mEsiti(10,nCasi)
mEsiti(1,nCasi) = es
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1)
mEsiti(4,nCasi) = n1
mEsiti(5,nCasi) = mRuote(r,2)
mEsiti(6,nCasi) = n2
mEsiti(9,nCasi) = nColpo 'ritardo
mEsiti(10,nCasi) = "in corso" ' segnalazione di caso in corso
End If
If bEsito1 = True Or bEsito2 = True Then Exit For ' se trova almeno un esito+ esce dal ciclo
Next
Exit For
End If ' nTotR1....
End If 'aNumR1...
Next 'esf
Next 'r
Next 'es
'----------------------------------------------1) output dettagliato di tutti i casi conclusi
Call Scrivi("RICERCA SFALDAMENTI 5°ESTRATTO o 1°ESTRATTO RUOTE CONSECUTIVE",1)
Call Scrivi("ARCHIVIO ANALIZZATO DAL " & DataEstrazione(ini) & " AL " & DataEstrazione(EstrazioneFin - 1),1)
Call Scrivi("Tot casi analizzati: " & nCasi & " di cui in corso: " & nCasiIC,1)
Call Scrivi("Max ritardo rilevato per lo sfaldamento di almeno uno degli estratti (su ruota di rilevazione): " & nMaxRit,1)
Call Scrivi
Call Scrivi(" -- Caso - DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit ",1)
For i = 1 To nCasi
If mEsiti(10,i) <> "in corso" Then
Call Scrivi(FormatSpace(i,7,1) & "° - " & DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i),5,1) & " " & FormatSpace(mEsiti(10,i),5,1))
End If
Next
'-----------------------------------------------2) output dei casi in attesa di sfaldamento
Call ColoreTesto(1)
Call Scrivi
Call Scrivi("CASISTICA IN ATTESA DI SFALDAMENTO (DI ALMENO UNO DEI DUE NUMERI)",1)
Call Scrivi(" -- Caso - DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit - Nota",1)
For i = 1 To nCasi
If mEsiti(10,i) = "in corso" Then
Call Scrivi(FormatSpace(i,7,1) & "° - " & DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i) + 1,5,1) & Space(4) & FormatSpace(mEsiti(10,i),5,1))
End If
Next
'-----------------------------------------------3) output statistica per ritardo (solo casi conclusi)
ColoreTesto 3
Call Scrivi
Call Scrivi("CASISTICA PER RITARDO (solo casi conclusi)",1)
Call Scrivi
ReDim mStatRit(nMaxRit + 1,2)
For i = 0 To nMaxRit
mStatRit(i + 1,1) = i ' inizializzo la colonna 1 della matrice con i rit rilevati. il rit 0 sta nella riga 1 etc
mStatRit(i + 1,2) = 0
Next
For i = 1 To nCasi
If mEsiti(10,i) <> "in corso" Then ' se il caso è concluso lo conteggio
mStatRit(mEsiti(9,i) + 1,2) = mStatRit(mEsiti(9,i) + 1,2) + 1 ' nb il rit 0 è sull'indice 1, il rit 1 è sull'indice 2 etc.
End If
Next
Call Scrivi("Ritardo casi",1)
For i = 1 To nMaxRit + 1' il più uno serve perchè i ritardi caricati sulla colonna1 partono da zero e questo serve x l'ordinamento
If mStatRit(i,2) > 0 Then Call Scrivi(FormatSpace(mStatRit(i,1),3,1) & Space(5) & mStatRit(i,2))
Next
'------------------------------------------------4) output dettaglio casi di max rit storico
ColoreTesto 2
Call Scrivi
Call Scrivi("DETTAGLIO CASISTICA DEI MAX RIT STORICI ",1)
Call Scrivi
c = 0
OrdinaMatrice mStatRit,1,1 ' ordino crescente per ritardo
Call Scrivi("DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit ",1)
For y = nMaxRit + 1 To 1 Step - 1
If mStatRit(y,2) > 0 Then
c = c + 1
For i = 1 To nCasi
If mStatRit(y,1) = mEsiti(9,i) Then
Call Scrivi(DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i),5,1) & Space(4) & FormatSpace(mEsiti(10,i),5,1))
End If
Next
End If
If c = 20 Then Exit For ' per scelta mi fermo ai casi dei primi 20 max ritardi
Next
End Sub
Ultima modifica:
miki55
Advanced Member >PLATINUM PLUS<
Se dici a me il listato è completo altrimenti non ti avrei potuto mettere l'output.
Mi aspettavo un commento tipo sì è giusto oppure "questo" (dettaglio) non va... boh
Ecco il listato. E' probabile che tra questa versione e quella di Luigi ci sia spazio almeno per
velocizzare la mia ma al momento sono riuscita a fare solo questo.
...non ho aggiunto altro, per non creare ulteriore confusione, ma da come hai anticipato
ha intuito che avevi capito benissimo quello che ho proposto.
Mi aspettavo un commento tipo sì è giusto oppure "questo" (dettaglio) non va... boh
Ecco il listato. E' probabile che tra questa versione e quella di Luigi ci sia spazio almeno per
velocizzare la mia ma al momento sono riuscita a fare solo questo.
...non ho aggiunto altro, per non creare ulteriore confusione, ma da come hai anticipato
ha intuito che avevi capito benissimo quello che ho proposto.
miki55
Advanced Member >PLATINUM PLUS<
Ho visto lo script: Bravissima...
Ti volevo chiedere solo due modifiche
- Oltre alle date della nascita della cinquina e quella dell'inizio della prev se è possibile aggiungere quella di sortita
- CASISTICA PER RITARDO (solo casi conclusi) ...il verde da fastidio agli occhi
304° - 23.04.2013 18.06.2013 TO 37 VE 22 - VE 22 12 colpo 13.07.2013 (data sortita)
...per il resto sei stata magnifica, come prevedevo!
Ti volevo chiedere solo due modifiche
- Oltre alle date della nascita della cinquina e quella dell'inizio della prev se è possibile aggiungere quella di sortita
- CASISTICA PER RITARDO (solo casi conclusi) ...il verde da fastidio agli occhi
304° - 23.04.2013 18.06.2013 TO 37 VE 22 - VE 22 12 colpo 13.07.2013 (data sortita)
...per il resto sei stata magnifica, come prevedevo!
Ultima modifica:
L
LuigiB
Guest
forse con l'intervento di Rosanna ho capito l'errore , solo che a me i colpi per far cadere un numero tra la coppia 78.02 che nell'estrazione [07712] [ 19] 13.02.2007 ha visto diventare i suoi componenti i soli superstiti delle rispettive ruote GE MI risultano essere 25 e non 29
A me risulta che sia caduto Estratto GE .. .. 02 .. .. [07736] [ 43] 10.04.2007
e 7736- (7712-1) fa proprio 25
Ecco lo script
comunque lo script l'ho modificato
A me risulta che sia caduto Estratto GE .. .. 02 .. .. [07736] [ 43] 10.04.2007
e 7736- (7712-1) fa proprio 25
Ecco lo script
Codice:
Option Explicit
Class clsCoppia
Private m_idEstr
Private aNum
Private aRuote
Private m_RitardoRaggiunto
Private m_Esito
Private m_Estratti
Private m_IdEstrEsito
Private m_aRuoteEsito
Private m_idEstrTabAna
Private m_Sfaldata
Sub Class_Initialize
' codice
ReDim aNum(0)
ReDim aRuote(0)
ReDim m_aRuoteEsito(0)
End Sub
Sub Class_Terminate
' codice
End Sub
Public Property Let IdEstrTabAna(v)
m_idEstrTabAna = v
End Property
Public Property Get IdEstrTabAna
IdEstrTabAna = m_idEstrTabAna
End Property
Public Property Get Sfaldata
Sfaldata = m_Sfaldata
End Property
Public Property Get RitardoRaggiunto
RitardoRaggiunto = m_RitardoRaggiunto
End Property
Public Property Get Esito
Esito = m_Esito
End Property
Public Property Get Estratti
Estratti = m_Estratti
End Property
Public Property Get idEstr
idEstr = m_idEstr
End Property
Public Property Get IdEstrEsito
IdEstrEsito = m_IdEstrEsito
End Property
Public Property Let idEstr(NewValue)
m_idEstr = NewValue
End Property
Sub SetNumeri(aNumeri)
aNum = aNumeri
' scrivere il codice
End Sub
Sub GetNumeri(aNumeri)
aNumeri = aNum
' scrivere il codice
End Sub
Sub SetRuote(aRt)
aRuote = aRt
' scrivere il codice
End Sub
Sub GetRuote(aRt)
aRt = aRuote
' scrivere il codice
End Sub
Function GetRuoteInteressateStr
Dim s,k
Dim nRuota
s = ""
For k = 1 To UBound(aRuote)
nRuota = Iif(aRuote(k) = 11,12,aRuote(k))
s = s & SiglaRuota(nRuota) & "."
Next
If s <> "" Then
s = Left(s,Len(s) - 1)
End If
GetRuoteInteressateStr = s
End Function
Function GetRuoteEsitoStr
Dim s,k
Dim nRuota
s = ""
For k = 1 To UBound(m_aRuoteEsito)
nRuota = Iif(m_aRuoteEsito(k) = 11,12,m_aRuoteEsito(k))
s = s & SiglaRuota(nRuota) & "."
Next
If s <> "" Then
s = Left(s,Len(s) - 1)
End If
GetRuoteEsitoStr = s
End Function
Function GetNumeriString
GetNumeriString = StringaNumeri(aNum,,True)
End Function
Sub CalcolaRitardo
Dim sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito
Dim k
ReDim aRt(UBound(aRuote))
For k = 1 To UBound(aRuote)
aRt(k) = Iif(aRuote(k) = 11,12,aRuote(k))
Next
m_Sfaldata = VerificaEsito(aNum,aRt,m_idEstrTabAna,1,,,sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito)
m_Esito = sEsito
m_RitardoRaggiunto = nColpi
m_Estratti = sEstratti
m_IdEstrEsito = IdEstrEsito
m_aRuoteEsito = aRuoteEsito
End Sub
End Class
Sub Main
Dim Inizio,Fine,idEstr,i,r
Dim sRuote
Dim CollCasi,clsCaso
ReDim aTabAna(220,55)
Inizio = EstrazioneIni
Fine = EstrazioneFin
Set CollCasi = GetNewCollection
For idEstr = Inizio To Fine
Messaggio "Analisi TabAnalitico Estrazione " & idEstr
'Call GetTabAnalitico(aTabAna,idEstr)
Call AddRigaTabAnalitico(aTabAna,idEstr)
Call CercaAmbi(aTabAna,idEstr,CollCasi)
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit Sub
Next
For r = 1 To 11
If r = 11 Then
sRuote = SiglaRuota(12) & "." & SiglaRuota(1)
ElseIf r = 10 Then
sRuote = SiglaRuota(r) & "." & SiglaRuota(r + 2)
Else
sRuote = SiglaRuota(r) & "." & SiglaRuota(r + 1)
End If
ReDim aT(8)
aT(1) = "Ambo isocrono"
aT(2) = "Ruote"
aT(3) = "Estrazione"
aT(4) = "UltimaEstrTabAna"
aT(5) = "CadutoDopoColpi"
aT(6) = "Esito"
aT(7) = "Numeri"
aT(8) = "Estrazione Esito"
Call InitTabella(aT)
i = 0
For Each clsCaso In CollCasi
If clsCaso.GetRuoteInteressateStr = sRuote Then
i = i + 1
Messaggio "Analisi casi trovati su " & sRuote & i
Call clsCaso.CalcolaRitardo
aT(1) = clsCaso.GetNumeriString
aT(2) = clsCaso.GetRuoteInteressateStr
aT(3) = GetInfoEstrazione(clsCaso.idEstr)
aT(4) = GetInfoEstrazione(clsCaso.IdEstrTabAna)
aT(5) = clsCaso.RitardoRaggiunto
aT(6) = clsCaso.Esito
aT(7) = clsCaso.Estratti
aT(8) = GetInfoEstrazione(clsCaso.IdEstrEsito)
If clsCaso.Sfaldata Then
Call AddRigaTabella(aT)
Else
Call AddRigaTabella(aT,vbGreen)
End If
If ScriptInterrotto Then Exit For
End If
Next
Call AvanzamentoElab(1,11,r)
If ScriptInterrotto Then Exit For
Call Scrivi(sRuote,True,,,,4)
Call CreaTabella(5,- 1)
Next
End Sub
Sub AddRigaTabAnalitico(aTabAna,idEstr)
Dim k,j,c,e,ee,r,nElim,nMax,nPosInizio
nMax = UBound(aTabAna)
' shifto le righe di una verso l'altro
For k = 2 To nMax
For j = 1 To 55
aTabAna(k - 1,j) = aTabAna(k,j)
Next
Next
' aggiungo l'estrazione corrente nell'ultima riga
c = 0
For k = 1 To 12
If k <> 11 Then
ReDim aEstratti(0)
Call GetArrayNumeriRuota(idEstr,k,aEstratti)
For j = 1 To 5
c = c + 1
aTabAna(nMax,c) = aEstratti(j)
Next
End If
Next
' cancello i numeri usciti nell'estrazione corrente
For r = 1 To 11
nElim = 0
nPosInizio =(r - 1) * 5
For k = nMax - 1 To 1 Step - 1
For e = 1 To 5
For ee = 1 To 5
If aTabAna(nMax,nPosInizio + e) = aTabAna(k,nPosInizio + ee) Then
aTabAna(k,nPosInizio + ee) = 0
nElim = nElim + 1
Exit For
End If
Next
Next
If nElim = 5 Then Exit For
Next
Next
End Sub
Sub CercaAmbi(aTabAna,idEstr,CollCasi)
Dim id,nPos
For id = 1 To UBound(aTabAna)
For nPos = 5 To 55 Step 5
If IsNumeriAdiacentiSolitari(aTabAna,id,nPos) Then
Call AddCasoInColl(CollCasi,aTabAna,id,nPos,idEstr)
End If
Next
Next
End Sub
Function IsNumeriAdiacentiSolitari(aTabAna,id,nPos)
Dim b
Dim k,nInizio,nTrov
b = False
nTrov = 0
nInizio = nPos
For k = nInizio To nInizio - 4 Step - 1
If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
Next
If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
nTrov = 0
nInizio = FuoriX(nPos + 1,55)
For k = nInizio To nInizio + 4
If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
Next
If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
b = True
End If
End If
IsNumeriAdiacentiSolitari = b
End Function
Sub AddCasoInColl(collCasi,aTabAna,id,nPos,idEstr)
Dim cCoppia
Dim sKey
ReDim aNum(2)
Set cCoppia = New clsCoppia
aNum(1) = aTabAna(id,nPos)
aNum(2) = aTabAna(id,FuoriX(nPos + 1,55))
If aNum(1) <> aNum(2) Then
ReDim aRuote(2)
aRuote(1) = nPos / 5
aRuote(2) = FuoriX(aRuote(1) + 1,11)
cCoppia.idEstr = idEstr -(UBound(aTabAna) - id)
cCoppia.idEstrTabAna = idEstr
cCoppia.SetNumeri(aNum)
cCoppia.SetRuote(aRuote)
sKey = "k" & cCoppia.idEstr & cCoppia.GetRuoteInteressateStr
Call AddCasoInCollEx(collCasi,cCoppia,sKey)
End If
End Sub
Sub AddCasoInCollEx(coll,obj,sKey)
On Error Resume Next
Call coll.Add(obj,sKey)
If Err <> 0 Then
Err.Clear
End If
End Subcomunque lo script l'ho modificato
Ultima modifica di un moderatore:
Rosanna
Super Member >PLATINUM<
x Luigi
secondo me l'inghippo sta nel fatto che al momento consideri le sortite dei numeri anche sull'altra ruota invece miki chiede che l'esito avvenga solo sulla ruota di rilevamento
GE 78 MI 2
la sortita(esito) 78 è valida solo se rilevata su GE e il 2 solo su MI.
Rimetto qui il mio listato con in più la data di sortita e... cosa non da poco l'ho velocizzato molto con un banale condizionamento a risparmio di energia....
secondo me l'inghippo sta nel fatto che al momento consideri le sortite dei numeri anche sull'altra ruota invece miki chiede che l'esito avvenga solo sulla ruota di rilevamento
GE 78 MI 2
la sortita(esito) 78 è valida solo se rilevata su GE e il 2 solo su MI.
Rimetto qui il mio listato con in più la data di sortita e... cosa non da poco l'ho velocizzato molto con un banale condizionamento a risparmio di energia....
Codice:
Option Explicit
Sub Main
'0904_16b Rosanna listato finale x Miki55
'http://forum.lottoced.com/f12/per-rosanna-106426/
Dim r1,r2,c,ini,ini2,fine1,fine2,es,esf,esff,r,p,n1,n2,i,y
Dim nCasi,nCasiIC,bCorso,nColpo,nMaxRit,bEsito1,bEsito2,nTotR1,nTotR2
Dim aNumR1(5),aNumR2(5)
Dim mRuote(11,2) ' matrice coppia ruote consecutive
ReDim mEsiti(11,0) ' matrice per tutta la casistica conclusa e non
ReDim mStatRit(0,0)' matrice per riversare la casistica dei ritardi x ordinare i rit
ini = 7440 ' <=== attenzione 1° estrazione con la ruota Nazionale
nCasi = 0 'contatore casi
nCasiIC = 0 'contatore casi in corso
nMaxRit = 0
'---------------il seguente blocco serve a creare la matrice delle coppie di ruote
c = 0
For r1 = 1 To 11
If r1 = 11 Then r1 = 12
r2 = r1 + 1
If r1 = 10 Then r2 = 12
If r1 = 12 Then r2 = 1
c = c + 1
mRuote(c,1) = r1 : mRuote(c,2) = r2
Next
'--------------------------------------------- Blocco analisi archivio
For es = ini To EstrazioneFin - 1 ' Escludo l'ultima estrazione di cui non posso cercare gli esiti
AvanzamentoElab ini,EstrazioneFin,es
For r = 1 To 11 ' scorro la MATRICE mRuote delle 11 coppie di ruote
n1 = Estratto(es,mRuote(r,1),5) ' 5° estratto di ciascuna coppia di ruote
n2 = Estratto(es,mRuote(r,2),1) ' 1° estratto di ciascuna coppia di ruote
For p = 1 To 5
aNumR1(p) = Estratto(es,mRuote(r,1),p) 'inizializzo i vettori con gli estratti
aNumR2(p) = Estratto(es,mRuote(r,2),p)
Next
If es + 200 > EstrazioneFin Then fine1 = EstrazioneFin Else fine1 = es + 200
ini2 = 0
For esf = es + 1 To fine1 ' scorro l'archivio per la ricerca del punto in cui i 2 num rimangono soli
For i = 1 To 5 ' scorro i due vettori con i numeri dell'estrazione base
If Posizione(esf,mRuote(r,1),aNumR1(i)) > 0 Then aNumR1(i) = 0 'man mano che si ripresentano i num li azzero sul vettore
If Posizione(esf,mRuote(r,2),aNumR2(i)) > 0 Then aNumR2(i) = 0 'idem per la seconda ruota
Next
nTotR1 = 0 ' variabile che mi serve per controllare la totale sortita gli altri estratti R1
nTotR2 = 0 ' idem c.s. per la ruota 2
If aNumR1(5) = 0 Or aNumR2(1) = 0 Then ' se almeno uno dei due num r15°e r21° è già uscito esci dal ciclo
Exit For
Else
If aNumR1(5) > 0 And aNumR2(1) > 0 Then ' se i due num r15°e r21° non sono ancora sortiti
For i = 1 To 4 'ad ogni estrazione ricontrollo se tutti gli altri sono usciti
nTotR1 = nTotR1 + aNumR1(i)
nTotR2 = nTotR2 + aNumR2(i + 1)
Next
If nTotR1 = 0 And nTotR2 = 0 Then ' se tutti gli altri sì i due totali saranno a zero
' per qui da questo punto inizia il controllo dei ritardi e gli esiti
ini2 = esf + 1
If esf + 200 > EstrazioneFin Then fine2 = EstrazioneFin Else fine2 = esf + 200
nCasi = nCasi + 1
nColpo = - 1'inizializzo la variabile per il conteggio dei ritardi
bEsito1 = False
bEsito2 = False 'inizializzo il controllo degli esiti
For esff = ini2 To fine2
nColpo = nColpo + 1 'contatore per il ritardo
If Posizione(esff,mRuote(r,1),n1) > 0 Then
bEsito1 = True
If nColpo > nMaxRit Then nMaxRit = nColpo
ReDim Preserve mEsiti(11,nCasi)
mEsiti(1,nCasi) = es 'Estrazione di rilevamento
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1) '1^ ruota
mEsiti(4,nCasi) = n1 '1° numero
mEsiti(5,nCasi) = mRuote(r,2) '2^ ruota
mEsiti(6,nCasi) = n2 '2°numero
mEsiti(7,nCasi) = n1 '1° numero sortito!
mEsiti(9,nCasi) = nColpo 'ritardo
mEsiti(11,nCasi)= esff
End If
If Posizione(esff,mRuote(r,2),n2) > 0 Then
bEsito2 = True
If nColpo > nMaxRit Then nMaxRit = nColpo
If bEsito1 = True Then
mEsiti(8,nCasi) = n2 ' 2° numero sortito!
Else
ReDim Preserve mEsiti(11,nCasi)
mEsiti(1,nCasi) = es 'Estrazione di rilevamento
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1)
mEsiti(4,nCasi) = n1
mEsiti(5,nCasi) = mRuote(r,2)
mEsiti(6,nCasi) = n2
mEsiti(8,nCasi) = n2 ' 2° numero sortito!
mEsiti(9,nCasi) = nColpo 'ritardo
mEsiti(11,nCasi)= esff
End If
End If
If bEsito1 = False And bEsito2 = False And esff = fine2 Then
nCasiIC = nCasiIC + 1
ReDim Preserve mEsiti(11,nCasi)
mEsiti(1,nCasi) = es
mEsiti(2,nCasi) = ini2 - 1
mEsiti(3,nCasi) = mRuote(r,1)
mEsiti(4,nCasi) = n1
mEsiti(5,nCasi) = mRuote(r,2)
mEsiti(6,nCasi) = n2
mEsiti(9,nCasi) = nColpo 'ritardo
mEsiti(10,nCasi) = "in corso" ' segnalazione di caso in corso
End If
If bEsito1 = True Or bEsito2 = True Then Exit For ' se trova almeno un esito+ esce dal ciclo
Next 'eff
Exit For
End If ' nTotR1....
End If
End If 'aNumR1...
Next 'esf
Next 'r
Next 'es
'----------------------------------------------1) output dettagliato di tutti i casi conclusi
Call Scrivi("RICERCA SFALDAMENTI 5°ESTRATTO o 1°ESTRATTO RUOTE CONSECUTIVE",1)
Call Scrivi("ARCHIVIO ANALIZZATO DAL " & DataEstrazione(ini) & " AL " & DataEstrazione(EstrazioneFin - 1),1)
Call Scrivi("Tot casi analizzati: " & nCasi & " di cui in corso: " & nCasiIC,1)
Call Scrivi("Max ritardo rilevato per lo sfaldamento di almeno uno degli estratti (su ruota di rilevazione): " & nMaxRit,1)
Call Scrivi
Call Scrivi(" -- Caso - DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit - DataEsito",1)
For i = 1 To nCasi
If mEsiti(10,i) <> "in corso" Then
Call Scrivi(FormatSpace(i,7,1) & "° - " & DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i),5,1) & " " & FormatSpace(mEsiti(10,i),3,1)& " " & DataEstrazione(mEsiti(11,i)))
End If
Next
'-----------------------------------------------2) output dei casi in attesa di sfaldamento
Call ColoreTesto(1)
Call Scrivi
Call Scrivi("CASISTICA IN ATTESA DI SFALDAMENTO (DI ALMENO UNO DEI DUE NUMERI)",1)
Call Scrivi(" -- Caso - DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit - Nota",1)
For i = 1 To nCasi
If mEsiti(10,i) = "in corso" Then
Call Scrivi(FormatSpace(i,7,1) & "° - " & DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i) + 1,5,1) & Space(4) & FormatSpace(mEsiti(10,i),5,1))
End If
Next
'-----------------------------------------------3) output statistica per ritardo (solo casi conclusi)
ColoreTesto 0
Call Scrivi
Call Scrivi("CASISTICA PER RITARDO (solo casi conclusi)",1)
Call Scrivi
ReDim mStatRit(nMaxRit + 1,2)
For i = 0 To nMaxRit
mStatRit(i + 1,1) = i ' inizializzo la colonna 1 della matrice con i rit rilevati. il rit 0 sta nella riga 1 etc
mStatRit(i + 1,2) = 0
Next
For i = 1 To nCasi
If mEsiti(10,i) <> "in corso" Then ' se il caso è concluso lo conteggio
mStatRit(mEsiti(9,i) + 1,2) = mStatRit(mEsiti(9,i) + 1,2) + 1 ' nb il rit 0 è sull'indice 1, il rit 1 è sull'indice 2 etc.
End If
Next
Call Scrivi("Ritardo casi",1)
For i = 1 To nMaxRit + 1' il più uno serve perchè i ritardi caricati sulla colonna1 partono da zero e questo serve x l'ordinamento
If mStatRit(i,2) > 0 Then Call Scrivi(FormatSpace(mStatRit(i,1),3,1) & Space(5) & mStatRit(i,2))
Next
'------------------------------------------------4) output dettaglio casi di max rit storico
ColoreTesto 2
Call Scrivi
Call Scrivi("DETTAGLIO CASISTICA DEI MAX RIT STORICI ",1)
Call Scrivi
c = 0
OrdinaMatrice mStatRit,1,1 ' ordino crescente per ritardo
Call Scrivi("DataEstraz DataIsocro R1 5° R2 1° - Esiti - Rit - DataEsito",1)
For y = nMaxRit + 1 To 1 Step - 1
If mStatRit(y,2) > 0 Then
c = c + 1
For i = 1 To nCasi
If mStatRit(y,1) = mEsiti(9,i) Then
Call Scrivi(DataEstrazione(mEsiti(1,i)) & " " & DataEstrazione(mEsiti(2,i)) & " " & SiglaRuota(mEsiti(3,i)) & " " & Format2(mEsiti(4,i)) & " " & _
SiglaRuota(mEsiti(5,i)) & " " & Format2(mEsiti(6,i)) & " - " & FormatSpace(mEsiti(7,i),2,1) & " " & FormatSpace(mEsiti(8,i),2,1) & _
FormatSpace(mEsiti(9,i),5,1) & " " & FormatSpace(mEsiti(10,i),3,1)& " " & DataEstrazione(mEsiti(11,i)))
End If
Next
End If
If c = 20 Then Exit For ' per scelta mi fermo ai casi dei primi 20 max ritardi
Next
End SubScusatemi ma non ho ben capito o forse mi è sfuggito qualche passaggio.
Lo script di Rosanna sfalda il primo dei due numeri sulla ruota di appartenenza.
Quello di Luigi sfalda il primo dei due, su una delle due ruote; la prima che arriva. In questo caso, sarebbero due numeri per ruota.
Da qui, la differenza degli attuali (tre di Rosanna, contro uno di Luigi), oltre ai ritardi che ovviamente risultano essere più alti nella ricerca ottenuta dallo script di Rosanna? Infatti, (Rosanna Rit. Max 53) - (Luigi Rit. Max 25).
Sono dunque due i numeri, o due più due se giocati su entrambe le ruote?
Grazie e buona settimana.
Lo script di Rosanna sfalda il primo dei due numeri sulla ruota di appartenenza.
Quello di Luigi sfalda il primo dei due, su una delle due ruote; la prima che arriva. In questo caso, sarebbero due numeri per ruota.
Da qui, la differenza degli attuali (tre di Rosanna, contro uno di Luigi), oltre ai ritardi che ovviamente risultano essere più alti nella ricerca ottenuta dallo script di Rosanna? Infatti, (Rosanna Rit. Max 53) - (Luigi Rit. Max 25).
Sono dunque due i numeri, o due più due se giocati su entrambe le ruote?
Grazie e buona settimana.
Ultima modifica:
L
LuigiB
Guest
ah ecco .. ancora una volta Rosanna mi fa capire meglio .. io pensavo che essendo 2 le ruote coinvolte anche la coppia andava verificata
per la sua caduta su tutte e due..non è un errore ho fatto cosi di proposito ...
per la sua caduta su tutte e due..non è un errore ho fatto cosi di proposito ...
L
LuigiB
Guest
ecco l oscript definitivo che dovrebbe accontentare tutti
Codice:
Option Explicit
Class clsCoppia
Private m_idEstr
Private aNum
Private aRuote
Private m_RitardoRaggiunto
Private m_Esito
Private m_Estratti
Private m_IdEstrEsito
Private m_aRuoteEsito
Private m_idEstrTabAna
Private m_Sfaldata
Private m_TipoAnalisi
Sub Class_Initialize
' codice
ReDim aNum(0)
ReDim aRuote(0)
ReDim m_aRuoteEsito(0)
End Sub
Sub Class_Terminate
' codice
End Sub
Public Property Let TipoAnalisi(v)
m_TipoAnalisi = v
End Property
Public Property Get TipoAnalisi
TipoAnalisi = m_TipoAnalisi
End Property
Public Property Let IdEstrTabAna(v)
m_idEstrTabAna = v
End Property
Public Property Get IdEstrTabAna
IdEstrTabAna = m_idEstrTabAna
End Property
Public Property Get Sfaldata
Sfaldata = m_Sfaldata
End Property
Public Property Get RitardoRaggiunto
RitardoRaggiunto = m_RitardoRaggiunto
End Property
Public Property Get Esito
Esito = m_Esito
End Property
Public Property Get Estratti
Estratti = m_Estratti
End Property
Public Property Get idEstr
idEstr = m_idEstr
End Property
Public Property Get IdEstrEsito
IdEstrEsito = m_IdEstrEsito
End Property
Public Property Let idEstr(NewValue)
m_idEstr = NewValue
End Property
Sub SetNumeri(aNumeri)
aNum = aNumeri
' scrivere il codice
End Sub
Sub GetNumeri(aNumeri)
aNumeri = aNum
' scrivere il codice
End Sub
Sub SetRuote(aRt)
aRuote = aRt
' scrivere il codice
End Sub
Sub GetRuote(aRt)
aRt = aRuote
' scrivere il codice
End Sub
Function GetRuoteInteressateStr
Dim s,k
Dim nRuota
s = ""
For k = 1 To UBound(aRuote)
nRuota = Iif(aRuote(k) = 11,12,aRuote(k))
s = s & SiglaRuota(nRuota) & "."
Next
If s <> "" Then
s = Left(s,Len(s) - 1)
End If
GetRuoteInteressateStr = s
End Function
Function GetRuoteEsitoStr
Dim s,k
Dim nRuota
s = ""
For k = 1 To UBound(m_aRuoteEsito)
nRuota = Iif(m_aRuoteEsito(k) = 11,12,m_aRuoteEsito(k))
s = s & SiglaRuota(nRuota) & "."
Next
If s <> "" Then
s = Left(s,Len(s) - 1)
End If
GetRuoteEsitoStr = s
End Function
Function GetNumeriString
GetNumeriString = StringaNumeri(aNum,,True)
End Function
Sub CalcolaRitardo
Dim sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA,bSfaldA
Dim sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB,bSfaldB
Dim sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito,bSfald
Dim k
If m_TipoAnalisi = 0 Then ' un estratto qualsiasi su una delle ruote
ReDim aRt(UBound(aRuote))
For k = 1 To UBound(aRuote)
aRt(k) = Iif(aRuote(k) = 11,12,aRuote(k))
Next
m_Sfaldata = VerificaEsito(aNum,aRt,m_idEstrTabAna,1,,,sEsito,nColpi,sEstratti,IdEstrEsito,aRuoteEsito)
ElseIf m_TipoAnalisi = 1 Then ' un estratto sulla ruota di origine
ReDim aRt(1)
ReDim aN(1)
aRt(1) = Iif(aRuote(1) = 11,12,aRuote(1))
aN(1) = aNum(1)
bSfaldA = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA)
aRt(1) = Iif(aRuote(2) = 11,12,aRuote(2))
aN(1) = aNum(2)
bSfaldB = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB)
If bSfaldA Or bSfaldB Then m_Sfaldata = True
If nColpiA <= nColpiB Then
nColpi = nColpiA
sEsito = sEsitoA
nColpi = nColpiA
sEstratti = sEstrattiA
IdEstrEsito = IdEstrEsitoA
Else
nColpi = nColpiB
sEsito = sEsitoB
nColpi = nColpiB
sEstratti = sEstrattiB
IdEstrEsito = IdEstrEsitoB
End If
ElseIf m_TipoAnalisi = 2 Then ' un estratto sulla ruota opposta a quella di origine
ReDim aRt(1)
ReDim aN(1)
aRt(1) = Iif(aRuote(1) = 11,12,aRuote(1))
aN(1) = aNum(2)
bSfaldA = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoA,nColpiA,sEstrattiA,IdEstrEsitoA,aRuoteEsitoA)
aRt(1) = Iif(aRuote(2) = 11,12,aRuote(2))
aN(1) = aNum(1)
bSfaldB = VerificaEsito(aN,aRt,m_idEstrTabAna,1,,,sEsitoB,nColpiB,sEstrattiB,IdEstrEsitoB,aRuoteEsitoB)
If bSfaldA Or bSfaldB Then m_Sfaldata = True
If nColpiA <= nColpiB Then
nColpi = nColpiA
sEsito = sEsitoA
nColpi = nColpiA
sEstratti = sEstrattiA
IdEstrEsito = IdEstrEsitoA
Else
nColpi = nColpiB
sEsito = sEsitoB
nColpi = nColpiB
sEstratti = sEstrattiB
IdEstrEsito = IdEstrEsitoB
End If
End If
m_Esito = sEsito
m_RitardoRaggiunto = nColpi
m_Estratti = sEstratti
m_IdEstrEsito = IdEstrEsito
m_aRuoteEsito = aRuoteEsito
End Sub
End Class
Sub Main
Dim Inizio,Fine,idEstr,i,r
Dim sRuote
Dim CollCasi,clsCaso
Dim nTipoAnalisi
Dim nTipoOutput
nTipoAnalisi = ScegliTipoAnalisi
nTipoOutput = ScegliTipoOutput
ReDim aTabAna(220,55)
Inizio = EstrazioneIni
Fine = EstrazioneFin
Set CollCasi = GetNewCollection
For idEstr = Inizio To Fine
Messaggio "Analisi TabAnalitico Estrazione " & idEstr
'Call GetTabAnalitico(aTabAna,idEstr)
Call AddRigaTabAnalitico(aTabAna,idEstr)
Call CercaAmbi(aTabAna,idEstr,CollCasi)
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit Sub
Next
If nTipoOutput = 0 Then
For r = 1 To 11
If r = 11 Then
sRuote = SiglaRuota(12) & "." & SiglaRuota(1)
ElseIf r = 10 Then
sRuote = SiglaRuota(r) & "." & SiglaRuota(r + 2)
Else
sRuote = SiglaRuota(r) & "." & SiglaRuota(r + 1)
End If
ReDim aT(8)
Call GetTitoliTb(aT)
Call InitTabella(aT)
i = 0
For Each clsCaso In CollCasi
If clsCaso.GetRuoteInteressateStr = sRuote Then
i = i + 1
Messaggio "Analisi casi trovati su " & sRuote & i
clsCaso.TipoAnalisi = nTipoAnalisi
Call clsCaso.CalcolaRitardo
aT(1) = clsCaso.GetNumeriString
aT(2) = clsCaso.GetRuoteInteressateStr
aT(3) = GetInfoEstrazione(clsCaso.idEstr)
aT(4) = GetInfoEstrazione(clsCaso.IdEstrTabAna)
aT(5) = clsCaso.RitardoRaggiunto
aT(6) = clsCaso.Esito
aT(7) = clsCaso.Estratti
aT(8) = GetInfoEstrazione(clsCaso.IdEstrEsito)
If clsCaso.Sfaldata Then
Call AddRigaTabella(aT)
Else
Call AddRigaTabella(aT,vbGreen)
End If
If ScriptInterrotto Then Exit For
End If
Next
Call AvanzamentoElab(1,11,r)
If ScriptInterrotto Then Exit For
Call Scrivi(sRuote,True,,,,4)
Call CreaTabella(5,- 1)
Next
Else
ReDim aT(8)
Call GetTitoliTb(aT)
Call InitTabella(aT)
i = 0
For Each clsCaso In CollCasi
i = i + 1
Messaggio "Analisi casi trovati su " & sRuote & i
clsCaso.TipoAnalisi = nTipoAnalisi
Call clsCaso.CalcolaRitardo
aT(1) = clsCaso.GetNumeriString
aT(2) = clsCaso.GetRuoteInteressateStr
aT(3) = GetInfoEstrazione(clsCaso.idEstr)
aT(4) = GetInfoEstrazione(clsCaso.IdEstrTabAna)
aT(5) = clsCaso.RitardoRaggiunto
aT(6) = clsCaso.Esito
aT(7) = clsCaso.Estratti
aT(8) = GetInfoEstrazione(clsCaso.IdEstrEsito)
If clsCaso.Sfaldata Then
Call AddRigaTabella(aT)
Else
Call AddRigaTabella(aT,vbGreen)
End If
Call AvanzamentoElab(i,CollCasi.count,r)
If ScriptInterrotto Then Exit For
Next
Call Scrivi(sRuote,True,,,,4)
Call CreaTabella(5,- 1)
End If
End Sub
Sub GetTitoliTb(aT)
ReDim aT(8)
aT(1) = "Ambo isocrono"
aT(2) = "Ruote"
aT(3) = "Estrazione"
aT(4) = "UltimaEstrTabAna"
aT(5) = "CadutoDopoColpi"
aT(6) = "Esito"
aT(7) = "Numeri"
aT(8) = "Estrazione Esito"
End Sub
Function ScegliTipoAnalisi
ReDim aVoci(2)
aVoci(0) = "Un estratto qualsiasi su una delle 2 ruote"
aVoci(1) = "Un estratto qualsiasi sulla ruota di origine"
aVoci(2) = "Un estratto qualsiasi sulla ruota opposta a quella di origine"
ScegliTipoAnalisi = ScegliOpzioneMenu(aVoci,0,"Tipo Analisi")
End Function
Function ScegliTipoOutput
ReDim aVoci(1)
aVoci(0) = "Diviso per ruote"
aVoci(1) = "Ordinato per colpi di caduta"
ScegliTipoOutput = ScegliOpzioneMenu(aVoci,0,"Tipo Analisi")
End Function
Sub AddRigaTabAnalitico(aTabAna,idEstr)
Dim k,j,c,e,ee,r,nElim,nMax,nPosInizio
nMax = UBound(aTabAna)
' shifto le righe di una verso l'altro
For k = 2 To nMax
For j = 1 To 55
aTabAna(k - 1,j) = aTabAna(k,j)
Next
Next
' aggiungo l'estrazione corrente nell'ultima riga
c = 0
For k = 1 To 12
If k <> 11 Then
ReDim aEstratti(0)
Call GetArrayNumeriRuota(idEstr,k,aEstratti)
For j = 1 To 5
c = c + 1
aTabAna(nMax,c) = aEstratti(j)
Next
End If
Next
' cancello i numeri usciti nell'estrazione corrente
For r = 1 To 11
nElim = 0
nPosInizio =(r - 1) * 5
For k = nMax - 1 To 1 Step - 1
For e = 1 To 5
For ee = 1 To 5
If aTabAna(nMax,nPosInizio + e) = aTabAna(k,nPosInizio + ee) Then
aTabAna(k,nPosInizio + ee) = 0
nElim = nElim + 1
Exit For
End If
Next
Next
If nElim = 5 Then Exit For
Next
Next
End Sub
Sub CercaAmbi(aTabAna,idEstr,CollCasi)
Dim id,nPos
For id = 1 To UBound(aTabAna)
For nPos = 5 To 55 Step 5
If IsNumeriAdiacentiSolitari(aTabAna,id,nPos) Then
Call AddCasoInColl(CollCasi,aTabAna,id,nPos,idEstr)
End If
Next
Next
End Sub
Function IsNumeriAdiacentiSolitari(aTabAna,id,nPos)
Dim b
Dim k,nInizio,nTrov
b = False
nTrov = 0
nInizio = nPos
For k = nInizio To nInizio - 4 Step - 1
If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
Next
If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
nTrov = 0
nInizio = FuoriX(nPos + 1,55)
For k = nInizio To nInizio + 4
If aTabAna(id,k) <> 0 Then nTrov = nTrov + 1
Next
If nTrov = 1 And aTabAna(id,nInizio) <> 0 Then
b = True
End If
End If
IsNumeriAdiacentiSolitari = b
End Function
Sub AddCasoInColl(collCasi,aTabAna,id,nPos,idEstr)
Dim cCoppia
Dim sKey
ReDim aNum(2)
Set cCoppia = New clsCoppia
aNum(1) = aTabAna(id,nPos)
aNum(2) = aTabAna(id,FuoriX(nPos + 1,55))
If aNum(1) <> aNum(2) Then
ReDim aRuote(2)
aRuote(1) = nPos / 5
aRuote(2) = FuoriX(aRuote(1) + 1,11)
cCoppia.idEstr = idEstr -(UBound(aTabAna) - id)
cCoppia.idEstrTabAna = idEstr
cCoppia.SetNumeri(aNum)
cCoppia.SetRuote(aRuote)
sKey = "k" & cCoppia.idEstr & cCoppia.GetRuoteInteressateStr
Call AddCasoInCollEx(collCasi,cCoppia,sKey)
End If
End Sub
Sub AddCasoInCollEx(coll,obj,sKey)
On Error Resume Next
Call coll.Add(obj,sKey)
If Err <> 0 Then
Err.Clear
End If
End Sub
Ultima modifica di un moderatore:
![on5.gif](http://[URL="http://imageshack.us/photo/my-images/690/on5.gif/"][IMG]http://img690.imageshack.us/img690/8002/on5.gif)
miki55
Advanced Member >PLATINUM PLUS<
Ciao Rosanna non voglio abusare della tua bontà, ma nel verificare i colpi, ho notato che forniscono qualche ritardo in meno.
Basta verificare DataIsocro e DataEsito
esempio:
304° - 23.04.2013 18.06.2013 TO 37 VE 22 - 22 10 13.07.2013 (11 colpi)
303° - 20.04.2013 18.05.2013 RO 85 TO 80 - 85 11 15.06.2013 (12 colpi)
grazie
Basta verificare DataIsocro e DataEsito
esempio:
304° - 23.04.2013 18.06.2013 TO 37 VE 22 - 22 10 13.07.2013 (11 colpi)
303° - 20.04.2013 18.05.2013 RO 85 TO 80 - 85 11 15.06.2013 (12 colpi)
grazie
L
LuigiB
Guest
io ho provato ora e funziona.. temo che tu abbia una versione vecchia di spaziometria a giudicare dall'errore che ti da ..
IDEM ANCHE PER ME
Che dire: siete incredibilmente bravi, altro che “ruggine!”.
Complimenti Rosanna, hai velocizzato egregiamente la ricerca.
Vorrei chiedervi se non troppo complicato:
Poiché i casi sono pochini per una statistica decente e più corposa, si potrebbe non coinvolgere Nazionale in modo che si possa partire dalla 3950 ( Da BA-CA a VE-BA?).
Buona giornata
Rosanna
Super Member >PLATINUM<
Sul ritardo avevo già anticipato questo:
Bisogna solo mettersi d'accordo... pensaci poi se necessario modifico. Pensa soprattutto che ritardo hanno i casi che si sfaldano subitissimo.
Ovvero non c'è stata "attesa"... Ritardo 0 (come ho messo io) o Rit 1?
Per Lucio
Lo script di Luigi gestisce già tutta la casistica. L'ultimo devo ancora provarlo ma era già così in precedenza.
ciao
Rosanna
Super Member >PLATINUM<
Sul ritardo avevo già anticipato questo:
Bisogna solo mettersi d'accordo... pensaci poi se necessario modifico. Pensa soprattutto che ritardo hanno i casi che si sfaldano subitissimo.
Ovvero non c'è stata "attesa"... Ritardo 0 (come ho messo io) o Rit 1?
Per Lucio
Lo script di Luigi gestisce già tutta la casistica. L'ultimo devo ancora provarlo ma era già così in precedenza.
ciao
Ciao a tutti, posto i dati di questa ricerca sperando di fare cosa gradita e anche per dare soddisfazione a chi ha prodotto gli script.
Ho adoperato lo script di Luigi perché dà, la possibilità in input box di scegliere e quindi ricavare i dati migliori secondo le impostazioni immesse.
https://dl.dropboxusercontent.com/u/18220462/IMMAGINI/DIFFERENZE.PNG
https://dl.dropboxusercontent.com/u/18220462/IMMAGINI/DIFFERENZE 2.PNG
Ho verificato sia la ruota di pertinenza (numeri messi in gioco sulla ruota di uscita), sia l’altra possibilità che mette in gioco i numeri sulla ruota opposta a quella di uscita; escludendo quella che giocherebbe quattro numeri per estratto.
Quelle che seguono sono le fasce di sfaldamento da dove è facile desumere che, le condizioni migliori sono quelle ottenute nel terzo input box (script di Luigi).
Giocare, cioè, non sulla ruota di pertinenza bensì su quella opposta; intuito che da sempre l’amico hettro, con il quale, insieme e ormai da anni si condivide questa passione.
Basti notare che nei primi nove colpi di gioco (teorico di due numeri per estratto), si ha una percentuale di sfaldamento che evidenzia quanto su affermato.
La prima immagine confronta per l’appunto la giocata sulla medesima ruota e quella su ruote opposte. Da qui si evince nei nove colpi di gioco:
56,25% nel primo caso (gioco sulla medesima ruota).
65,46% nel secondo caso (gioco su ruota opposta).
Detto ciò, si evidenzia anche lo storico più basso che hanno le formazioni ricavate dal terzo input box (gioco su ruota opposta); 48 contro 55.
Non basta:
Dalla 3950 si ottengono 973 eventi (statistica più corposa e quindi più affidabile) con uno storico di 49; uno in più della precedente che parte dalla 7440 ma con una percentuale che supera sempre quella ottenuta nei nove colpi della giocata fatta su ruota di pertinenza.
Saluti
Ho adoperato lo script di Luigi perché dà, la possibilità in input box di scegliere e quindi ricavare i dati migliori secondo le impostazioni immesse.
https://dl.dropboxusercontent.com/u/18220462/IMMAGINI/DIFFERENZE.PNG
https://dl.dropboxusercontent.com/u/18220462/IMMAGINI/DIFFERENZE 2.PNG
Ho verificato sia la ruota di pertinenza (numeri messi in gioco sulla ruota di uscita), sia l’altra possibilità che mette in gioco i numeri sulla ruota opposta a quella di uscita; escludendo quella che giocherebbe quattro numeri per estratto.
Quelle che seguono sono le fasce di sfaldamento da dove è facile desumere che, le condizioni migliori sono quelle ottenute nel terzo input box (script di Luigi).
Giocare, cioè, non sulla ruota di pertinenza bensì su quella opposta; intuito che da sempre l’amico hettro, con il quale, insieme e ormai da anni si condivide questa passione.
Basti notare che nei primi nove colpi di gioco (teorico di due numeri per estratto), si ha una percentuale di sfaldamento che evidenzia quanto su affermato.
La prima immagine confronta per l’appunto la giocata sulla medesima ruota e quella su ruote opposte. Da qui si evince nei nove colpi di gioco:
56,25% nel primo caso (gioco sulla medesima ruota).
65,46% nel secondo caso (gioco su ruota opposta).
Detto ciò, si evidenzia anche lo storico più basso che hanno le formazioni ricavate dal terzo input box (gioco su ruota opposta); 48 contro 55.
Non basta:
Dalla 3950 si ottengono 973 eventi (statistica più corposa e quindi più affidabile) con uno storico di 49; uno in più della precedente che parte dalla 7440 ma con una percentuale che supera sempre quella ottenuta nei nove colpi della giocata fatta su ruota di pertinenza.
Saluti
Allegati
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 18 gennaio 2025Bari2476027212Cagliari2108770417Firenze7484071272Genova1307334718Milano0134095548Napoli4623250306Palermo4407014684Roma8878647404Torino0787673853Venezia3125041802Nazionale4982596567Estrazione Simbolotto
Bari
0313312335