PER MIKE58

[trivellatomariotretre33]

CIAO MIKE58 MI PUOI FARE UNA MODIFICA A QUESTO SCRIPT INVECE DEL RITARDO I FREQUENTI MINIMO E FREQUENTI MASSIMO GRAZIE DI CUORE CON ANTICIPO
QUESTO E LO SCRIPT



Option Explicit

Sub Main
Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteS el,nLunghetteDaTrov
Dim TimeStart
Dim k,CollComb,cColonna
Dim aN
Dim TipoAlgo


nTrov = 0
nNumSel = ScegliNumeri(aN)



'aN = Array(0,16,49,60)
nSorte = 2' ScegliEsito
nClasseLunghetta = 3' ScegliClassseLunghetta
TipoAlgo = 1








nRuoteSel = 1 : ReDim aRuote(1) : aRuote(1) = NZ_ 'SelRuote(aRuote)
nLunghetteDaTrov = 10 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
ReDim Preserve aRuote(nRuoteSel)
nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote ))
nMoltip = 8
sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))

sMsg = "Inserire il ritardo minimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per 3"

nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))


fin = EstrazioneFin
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1

TimeStart = Timer

Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghett a,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRit Min,nRitMax,nLunghetteDaTrov,TipoAlgo)
'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,E strazioneFin,nClasseLunghetta,nSorte,CollComb)

Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
For Each cColonna In CollComb
Call Scrivi(cColonna.GetStringaNum & " Rit " & cColonna.Ritardo)

Next

Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
End Sub

Function ScegliClassseLunghetta
Dim aVoci(30)
Dim k,i
For k = 2 To(2 - 1) + UBound(aVoci)
i = i + 1
aVoci(i) = k
Next
k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = NZ_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function
Function FormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una stringa
' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function

 

[Mike58]

No Mi spiace è il nuovo script di Luigi per le lunghettePiuRitardate e non riesco a trovare il bandolo per stabilirne le presenze.
Se ha voglia Luigi o altri possono magari intervenire.

Per Ora Passo.

Ciao

 

[trivellatomariotretre33]

grazie Micke58 lo so che e di Luigi poiche e publico x tutti in spaziometria o pensato questa modifica che non cambia certo le cose
anzi aiuta tutti per altre ricerche
se poi Luigi vorra farlo mi fa tanto piacere era solo x non scomodare di piu di quanto gia a fatto x tutti noi un saluto circolare euna stretta di mano se pi puo altrimenti ancora grazie.

 

[Mike58]

Ciao Trivellato, nell'altro post Luigi ha cortesemente isolato il vettore della collection e ha permesso di scrivere anche le frequenze.
Però se ti capita leggi anche il post dopo il mio intervento e valuta quello che raccoglie lo script..

Option Explicit
Sub Main
 Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
 Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov
 Dim TimeStart
 Dim k,CollComb,cColonna
 Dim aN
 Dim TipoAlgo
 Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
 nTrov = 0
 nNumSel = ScegliNumeri(aN)
 'aN = Array(0,16,49,60)
 nSorte = 2' ScegliEsito
 nClasseLunghetta = 3' ScegliClassseLunghetta
 TipoAlgo = 0
 nRuoteSel = 1 : ReDim aRuote(1) : aRuote(1) = TT_ 'SelRuote(aRuote)
 nLunghetteDaTrov = 10 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
 ReDim Preserve aRuote(nRuoteSel)
 nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
 nMoltip = 1
 sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
 sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
 sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
 nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))
 sMsg = "Inserire il ritardo minimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
 sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
 sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per 3"
 nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))
 fin = EstrazioneFin
 Ini = fin - nRitMax
 If Ini <= 0 Then Ini = 1
 TimeStart = Timer
 Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo)
 'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,EstrazioneFin,nClasseLunghetta,nSorte,CollComb)
 Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
 For Each cColonna In CollComb
  Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
  Call Scrivi(cColonna.GetStringaNum & " Rit " & cColonna.Ritardo & " Freq :" & RetFrq)
 Next
 Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
End Sub
Function ScegliClassseLunghetta
 Dim aVoci(30)
 Dim k,i
 For k = 2 To(2 - 1) + UBound(aVoci)
  i = i + 1
  aVoci(i) = k
 Next
 k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
 ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
 Dim t,k,bTutte
 bTutte = False
 t = ScegliRuote(aRuote)
 For k = 1 To t
  If aRuote(k) = TT_ Then
   bTutte = True
   Exit For
  End If
 Next
 If bTutte Then
  ReDim aRuote(10)
  For k = 1 To 10
   aRuote(k) = k
  Next
  SelRuote = 10
 Else
  SelRuote = t
 End If
End Function
Function FormattaSecondi(s)
 'Questa Function trasforma il numero di secondi passato come parametro in una stringa
 ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
 ' s ---> Numero di secondi da formattare
 ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
 Dim hh
 Dim Mm
 Dim Ss
 Dim TimeStr
 hh = s \ 3600
 Mm =(s Mod 3600) \ 60
 Ss = s -((hh * 3600) +(Mm * 60))
 TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
 FormattaSecondi = TimeStr
End Function

 

[trivellatomariotretre33]

grazie Mike58 o visto lo script ma non mi trova la massima frequenza di come io volevo cioe di una terzina o ecc...

 

[Mike58]

Si adesso ho capito cosa vorresti, allora quello script non è indicato per il tuo scopo.
Lo script in esame ricerca le lunghette + ritardate con apposito codice, mentre per le lunghette + frequenti il codice non esiste.

Se ti accontenti dello sviluppo in Terzine per sorte di Ambo, posso vedere se riesco con i codici esistenti di ricrearlo, tempi di elaborazione permettendo.

Ti faccio sapere.

 

[trivellatomariotretre33]

SI GRAZIE MIKE58 PER AVERMI FATTO CAPIRE LA DIFFERENZA DEI FRQ E RIT ECC ...
MI ACCONTENTO SE MI FARESTI PERVENIRE dello sviluppo in Terzine per sorte di Ambo GRAZIE DI CUORE MIKE58

 

[Mike58]

Ciao Trivellato, ho rivisto un mio script e l'ho modificato allo scopo, purtroppo i tempi di elaborazione sono circa di 10 minuti.
E' necessario stabilire un filtro minimo usa il default impostato, anche se la frequenza massima arriva a 780 (mi pare) , lo script se non trova combinazioni valide per 3 min va in errore, così come ti dico trova + combinazioni e continua a lavorare e poi grazie al filtro impostato di righe da visualizzare filtra le prime in ordine discendente.

Puoi anche stoppare prima per vedere la videata dei trovati.


Ciao

Sub Main
 Dim k,s,ru(1),anum(3),Rt(1)
 Dim nClasse,nColonneTot
 ReDim aNumeri(90)
 Dim aCol
 Clas = CInt(InputBox("QUALE CLASSE DI SVILUPPO",,3))
 sorte = CInt(InputBox("QUALE SORTE DI ESITO",,2))
 r = InputBox("QUALE RUOTA",,11)
 mrt = CInt(InputBox("QUALE RITARDO MINIMO CONSIDERO ",,650))
 righe = CInt(InputBox("QUANTE RIGHE VISUALIZZO ",,15))
 'ff = CInt(InputBox("QUANTE ESTRAZIONI DALLA FINE",,0))
 Ini = EstrazioneIni
 'fin = EstrazioneFin - ff
 fine = EstrazioneFin
 Tot = fine - fin
 TimeStart = Timer
 Scrivi "Ricerca delle TERZINE più Frequenti su Ruota Tutte",1,1,2,4,3
 Scrivi "Sviluppo Combinazioni in Terne per sorte di..." & NomeSorte(sorte),1
 Scrivi "Estrazione inizio..." & DataEstrazione(Ini) & "  alla estrazione fine..." & DataEstrazione(fine),1
 Scrivi "Ruota Analizzata..." & NomeRuota(r),1
 Scrivi
 'Scrivi "Situazione statistica a " & Tot & " estrazioni fà ",1,1,,1,2
 Call Scrivi("Analisi sulla Frequenza Minima > a " & mrt,1,1,,2,2)
 Scrivi
 ReDim T(11)
 T(1) = " Casi "
 T(2) = " Combinazione "
 T(3) = " Ritardo "
 T(4) = " Freq "
 T(5) = " Rit. Max "
 T(6) = " Incr Max "
 'T(7) = " Ruota Ritardo "
 'T(8) = " Id Estr "
 T(9) = " Verifica Esito "
 'T(10) = " Colpi "
 T(11) = " Info Estraz. esiti "
 Call InitTabella(T,2,,3,5)
 ru(1) = r
 Rt(1) = 11
 nClasse = Clas ' sviluppo in classe di sorte
 ' inizializzo i numeri da sviluppare in questo caso 90
 ' ma potrebbero essere anche di meno
 For k = 1 To 90
  aNumeri(k) = k
 Next
 'inizializza lo sviluppo
 nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
 k = 0
 ' ciclo che continua fino a quando le colonne non finiscono
 Do While GetCombSviluppo(aCol)
  k = k + 1 ' conteggio colonna corrente
  ' costruisco la stringa che contiene la colonna
  anum(1) = aCol(1)
  anum(2) = aCol(2)
  anum(3) = aCol(3)
  If anum(1) <> anum(3) And anum(2) <> anum(3) Then
   'sf = SerieFreqTurbo(Ini,fin,anum,ru,sorte)
   Call StatisticaFormazioneTurbo(anum,ru,sorte,rit,ritmax,Incr,fre,Ini,fine)
   Call VerificaEsitoTurbo(anum,ru,fine - rit,2,1,Nothing,esito,colpi,estratti,id)
   'Call VerificaEsitoTurbo(anum,Rt,fine - sf,2,,,esitoP,,estrP,idP)
   'If esito <> "" Then s = FormatSpace(kk,2) & " -  " & StringaNumeri(anum,,True) & "   -  Ritarda da... " & sf & _
   '" > " & estrP & " ( " & idP & " ) " & "  - Esiti Successivi... " & estratti & "   - al colpo..." & Format2(colpi) & _
   '" - " & GetInfoEstrazione(id)
   'If esito = "" Then s = FormatSpace(kk,2) & " -  " & StringaNumeri(anum,,True) & "   -  Ritarda da... " & sf & _
   '" > " & estrP & " ( " & idP & " ) "
   ReDim v(11)
   v(1) = kk
   v(2) = StringaNumeri(anum,,True)
   v(3) = rit
   v(4) = fre
   v(5) = ritmax' + colpi
   v(6) = Incr
   'v(7) = estrP
   'v(8) = idP
   v(9) = estratti
   'v(10) = colpi
   v(11) = GetInfoEstrazione(id)
   If fre > mrt Then
    kk = kk + 1
    Call AddRigaTabella(v,,,3)
    'Call Scrivi(s)
    Call Messaggio("Combinazione.... " & k & "    Trovate..... " & kk)
    Call AvanzamentoElab(ini,fin,k)
    If ScriptInterrotto Then Exit Do
   End If
  End If
 Loop
 'Call SetTableWidth("100%")
 Call CreaTabella(4,,,righe)
 Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
 Scrivi
 'Scrivi
 Scrivi "**** Richiesta by Trivellato ***** Forum LottoCed ***** Script By Mike58 **** ",1,1,1,5,3
End Sub
Function FormattaSecondi(s)
 'Questa Function trasforma il numero di secondi passato come parametro in una stringa
 ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
 ' s ---> Numero di secondi da formattare
 ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
 Dim hh
 Dim Mm
 Dim Ss
 Dim TimeStr
 hh = s \ 3600
 Mm =(s Mod 3600) \ 60
 Ss = s -((hh * 3600) +(Mm * 60))
 TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
 FormattaSecondi = TimeStr
End Function

 

[trivellatomariotretre33]

GRAZIE MIKE58 PER LO SCRIPT SE IN SEGUITO SI POTRA FARE DI PIU IO SONO QUI.