variazione script di Luigi per lunghette

ppaaoolloo · 26 Gennaio 2017

ciao
mi sembra che già era stato fatto uno script del tipo come lo chiedo io,
ma non riesco a trovarlo, mi serve che ricerca delle lunghette per ritardo
ma con dei numeri inseriti da me.
molto buono è questo script che riporto qui sotto del grande Luigi
per le lunghette ma purtroppo per me non permette di inserire numeri,
qualcuno riesce ad apportargli questa modifica che ho spiegato?
preciso che potrei inserire una quantità di numeri dai 20 ai 60.

ringrazio anticipatamente chi vorrà provarci

ciao

Option Explicit
Class clsCombinazione
Private m_UltEstUscita
Private m_Key
Private m_aNum
Private m_Classe
Private m_Index
Private m_aBNum
Sub Class_Initialize
' codice

End Sub
Sub Class_Terminate
' codice
End Sub

Public Property Get Index
Index = m_Index
End Property
Public Property Let Index(NewValue)
m_Index = NewValue
End Property
Public Property Get Classe
Classe = m_Classe
End Property
Public Property Let Classe(NewValue)
m_Classe = NewValue
End Property
Public Property Get Key
Key = m_Key
End Property
Public Property Let Key(NewValue)
m_Key = NewValue
End Property
Public Property Get aNum
aNum = m_aNum
End Property
Public Property Let aNum(NewValue)
m_aNum = NewValue
End Property
Public Property Get UltEstUscita
UltEstUscita = m_UltEstUscita
End Property
Public Property Let UltEstUscita(NewValue)
m_UltEstUscita = NewValue
End Property
Function GetStringaNum
GetStringaNum = StringaNumeri(m_aNum,,True)
End Function

Function IsNumeroPresente(N)
IsNumeroPresente = m_aBNum(N)

End Function

Sub RefreshABnum
ReDim m_abnum(90)
Dim k

For k = 1 To 90
m_abnum(k) = False
Next
For k = 1 To UBound(m_aNum)
m_abnum(m_aNum(k)) = True
Next
End Sub
End Class
Sub Main
Dim collCombBase,CollLunghette,collLungTrov,nSorte,aRuote,Ini,fin,sMsg,nMoltip
Dim nCicloTeo,nRitMax,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov,nCombBaseTrov
Dim clsComb,clsCombTmp,clsLunghette,TipoMetodo
Dim cItem,cItemNew,sKey,nTrovate
Dim i,nTrov,nIndexMax,bFound,k,nIniTmp
Dim TimeStart

TipoMetodo = 2

nTrov = 0
nSorte = ScegliEsito
nClasseLunghetta = ScegliClassseLunghetta
nRuoteSel = SelRuote(aRuote)
nLunghetteDaTrov = Int(InputBox("Lunghette da trovare","Quantità lunghette",3))
ReDim Preserve aRuote(nRuoteSel)
nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
nMoltip = 30
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 = Int(InputBox(sMsg,,nCicloTeo * nMoltip))
fin = EstrazioneFin
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1

TimeStart = Timer
Call Messaggio("Individua le combinazioni di classe " & nSorte & " uscite nel periodo")
Call AlimentaCollCombUscite(collCombBase,nSorte,aRuote,Ini,fin)
nCombBaseTrov = collCombBase.count
Call Messaggio("Ordinamento per ritardo delle combinazioni trovate " & nCombBaseTrov)
Call OrdinaItemCollection(collCombBase,"UltEstUscita","Key",,1)
Call Messaggio("Imposta posizioni classifica ritardi")
Call ImpostaPosizioni(collCombBase,nIndexMax)

sMsg = "Le combinazioni base di classe " & nSorte
sMsg = sMsg & " (uscite nel periodo analizzato di " & nRitMax & " estrazioni) "
sMsg = sMsg & " sono " & nCombBaseTrov
sMsg = sMsg & " sulle ruote " & StringaRuote(aRuote)
Call Scrivi(sMsg)
Call Scrivi

Set collLungTrov = GetNewCollection

i = 0
nTrovate = 0
For Each clsComb In collCombBase
i = i + 1

Call Messaggio("Radice " & clsComb.GetStringaNum & " Pos " & clsComb.Index & "/" & nIndexMax & " (" & i & "/" & nCombBaseTrov & ")")
If TipoMetodo = 1 Then
bFound = InitCercaLunghetta(collCombBase,clsComb,nSorte,nClasseLunghetta,CollLunghette,collLungTrov)
ElseIf TipoMetodo = 2 Then
bFound = InitCercaLunghetta2(collCombBase,clsComb,nSorte,nClasseLunghetta,CollLunghette,collLungTrov)

End If
If bFound Then nTrovate = nTrovate + 1
'If collLungTrov.count >= nLunghetteDaTrov Then Exit For
If nTrovate >= nLunghetteDaTrov Then Exit For

Call AvanzamentoElab(1,nCombBaseTrov,i)
If ScriptInterrotto Then Exit For
Next
For Each clsComb In collLungTrov
Call Scrivi(clsComb.GetStringaNum & " -- " & clsComb.UltEstUscita & " - Rit " & RitardoCombinazioneTurbo(aRuote,clsComb.aNum,nSorte,fin))
Next

Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
End Sub
Function InitCercaLunghetta(collCombBase,cItemBase,nSorte,nClasseLunghetta,collLunghette,collLungTrov)

Dim nClasseTmp,nTrovate,nDaFare,nFatte,IndexBase
Dim aNumSvil,aCol,aColNew,N,sKey,cItem,cItemNew,cItemTmp,bValida,CollTmp
Set collLunghette = GetNewCollection

IndexBase = cItemBase.Index

nClasseTmp = nSorte + 1
For N = 1 To 90

aNumSvil = cItemBase.anum
'If PuntiSuArray(aNumSvil,aN) = 0 Then
If cItemBase.IsNumeroPresente(N) = False Then

bValida = True
Call InitSviluppoIntegrale(aNumSvil,nSorte - 1)
Do While GetCombSviluppo(aCol)
aColNew = aCol
ReDim Preserve aColNew(nSorte)
aColNew(nSorte) = N
Call OrdinaMatriceTurbo(aColNew,1)
sKey = "k" & StringaNumeri(aColNew,,True)

If GetItemCollection(collCombBase,sKey,cItem) Then
If cItem.Index > IndexBase Then
bValida = False
Exit Do
End If
End If
Loop
If bValida Then
ReDim Preserve aNumSvil(nClasseTmp)
aNumSvil(nClasseTmp) = N
Call OrdinaMatriceTurbo(aNumSvil,1)
Set cItem = New clsCombinazione
cItem.Index = IndexBase
cItem.aNum = aNumSvil
Call cItem.RefreshABnum
'collLunghette.Add cItem
sKey = "k" & StringaNumeri(aNumSvil,,True)

Call AddItemColl(collLunghette,cItem,sKey)

End If
End If

Next

Do While nClasseTmp < nClasseLunghetta
nClasseTmp = nClasseTmp + 1
Set CollTmp = GetNewCollection
nTrovate = 0
nDaFare = collLunghette.count
nFatte = 0
For Each cItem In collLunghette
For N = 1 To 90

aNumSvil = cItem.aNum
'If PuntiSuArray (aNumSvil , aN) = 0 Then
If cItem.IsNumeroPresente(N) = False Then
bValida = True
Call InitSviluppoIntegrale(aNumSvil,nSorte - 1)
Do While GetCombSviluppo(aCol)
aColNew = aCol
ReDim Preserve aColNew(nSorte)
aColNew(nSorte) = N
Call OrdinaMatriceTurbo(aColNew,1)
sKey = "k" & StringaNumeri(aColNew,,True)

If GetItemCollection(collCombBase,sKey,cItemTmp) Then
If cItemTmp.Index > IndexBase Then
bValida = False
Exit Do
End If
End If
Loop
If bValida Then
ReDim Preserve aNumSvil(nClasseTmp)
aNumSvil(nClasseTmp) = N
Call OrdinaMatriceTurbo(aNumSvil,1)
Set cItemNew = New clsCombinazione
cItemNew.Index = IndexBase
cItemNew.aNum = aNumSvil
Call cItemNew.RefreshABnum
sKey = "k" & StringaNumeri(aNumSvil,,True)

If AddItemColl(CollTmp,cItemNew,sKey) Then

nTrovate = nTrovate + 1
End If
End If

End If
Next
'nFatte = nFatte + 1
'Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit Do

Next
If nTrovate = 0 Then Exit Do
If ScriptInterrotto Then Exit Do
Set collLunghette = CollTmp

Loop

If nTrovate > 0 Then
For Each cItem In collLunghette
Set cItemNew = New clsCombinazione
cItemNew.aNum = cItem.aNum
cItemNew.Classe = cItem.Classe
cItemNew.Index = cItem.Index
cItemNew.UltEstUscita = cItem.UltEstUscita

collLungTrov.Add cItemNew
Next
InitCercaLunghetta = True
End If

End Function
Function InitCercaLunghetta2(collCombBase,cItemBase,nSorte,nClasseLunghetta,collLunghette,collLungTrov)

Dim cItemTmp,cItemTmp2,IndexBase,aNumBase,aNumTmp,aColNew
Dim CollTmp,cItemNew,cItem,sKey,nTrovate
Dim k,y,i
Dim nClasseTmp,collLunghetteTmp,aCol,bValida

Set collLunghette = GetNewCollection
collLunghette.Add cItemBase

IndexBase = cItemBase.Index
aNumBase = cItemBase.aNum
nTrovate = 0

nClasseTmp = nSorte
Do While nClasseTmp < nClasseLunghetta
nTrovate = 0
Set collLunghetteTmp = GetNewCollection
ReDim abLunghUsate(collCombBase.count)
For Each cItem In collLunghette
aNumBase = cItem.aNum
i = 0
For Each cItemTmp In collCombBase
i = i + 1
If Not abLunghUsate(i) Then
abLunghUsate(i) = True
If cItemTmp.Index <= IndexBase Then
aNumTmp = cItemTmp.aNum
If PuntiSuArray(aNumBase,aNumTmp) = nSorte - 1 Then

ReDim aB(90)
For k = 1 To nSorte
aB(aNumTmp(k)) = True
Next
For k = 1 To UBound(aNumBase)
aB(aNumBase(k)) = True
Next
Call ArrayBNumToArrayNum(aB,aColNew)
Call InitSviluppoIntegrale(aColNew,nSorte)
bValida = True
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
If GetItemCollection(collCombBase,sKey,cItemTmp2) Then
If cItemTmp2.Index > IndexBase Then
bValida = False
Exit Do
End If
End If

Loop

If bValida Then
'abLunghUsate ( i) = True
Set cItemNew = New clsCombinazione
cItemNew.Index = IndexBase
cItemNew.aNum = aColNew
Call cItemNew.RefreshABnum
sKey = "k" & StringaNumeri(aColNew,,True)

If AddItemColl(collLunghetteTmp,cItemNew,sKey) Then

nTrovate = nTrovate + 1
End If
End If
End If
Else
Exit For
End If
End If
Next

Next
If nTrovate > 0 Then
Set collLunghette = collLunghetteTmp
nClasseTmp = nClasseTmp + 1
Else
Exit Do
End If

Loop

If nClasseTmp = nClasseLunghetta Then
For Each cItem In collLunghette
Set cItemNew = New clsCombinazione
cItemNew.aNum = cItem.aNum
cItemNew.Classe = cItem.Classe
cItemNew.Index = cItem.Index
cItemNew.UltEstUscita = cItem.UltEstUscita
collLungTrov.Add cItemNew
Next
InitCercaLunghetta2 = True
End If
End Function
Sub ImpostaPosizioni(coll,nRetIndexMax)
Dim i,nLastEstUscita,clsComb
i = 0
nLastEstUscita = 0
For Each clsComb In coll
If clscomb.UltEstUscita <> nLastEstUscita Then
i = i + 1
End If
nLastEstUscita = clscomb.UltEstUscita
clsComb.Index = i
Next
nRetIndexMax = i
End Sub

Sub AlimentaCollCombUscite(coll,nSorteCerc,aRuote,Ini,Fin)
Dim idEstr,r,k,nCombSvil,sKey
Dim clsComb
ReDim aColonne(0)
ReDim aNum(0)
ReDim aCol(0)
nCombSvil = Combinazioni(5,nSorteCerc)
Set coll = GetNewCollection

For idEstr = Ini To Fin
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(idEstr,aRuote(r),aNum)
Call OrdinaMatrice(aNum,1)
Call InitSviluppoIntegrale(aNum,nSorteCerc)
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
Call GetClsComb(coll,sKey,clsComb,aCol,nSorteCerc)
clsComb.UltEstUscita = idEstr

Loop
Next
Call AvanzamentoElab(Ini,Fin,idEstr)
If ScriptInterrotto Then Exit For
Next
End Sub
Function GetClsComb(coll,sKey,clsComb,aCol,nClasse)
On Error Resume Next
Set clsComb = coll(sKey)
If Err <> 0 Then
Err.Clear
Set clsComb = New clsCombinazione
clsComb.Key = sKey
clsComb.aNum = aCol
clsComb.Classe = nClasse
clsComb.RefreshABnum
Call coll.Add(clsComb,sKey)
GetClsComb = False
Else
GetClsComb = True
End If
End Function
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

LuigiB · 26 Gennaio 2017

ciao , la logica con la quale funziona questo script rende impossibile farlo lavorare sui numeri scelti dall'utente , in pratica lo script analizza il flusso delle estrazioi e da li ricava le lunghette.

chicco3 · 27 Gennaio 2017

Ciao luigi è possibile avere uno script? Chicco3

LuigiB · 27 Gennaio 2017

posso dirti che ho fatto di tutto per insegnare ma le persone che hanno recepito metaforicamente si contano sulle dita di una sola mano (di un falegname) ...
Comunqe seppur in numero esiguo ci sono anche altri in grado di assolvere il compito .. tu lo script postalo in uno specifico thread potrebbe darsi che qualcuno lo faccia (compreso me)

ppaaoolloo · 27 Gennaio 2017

ciao Luigi
grazie per la risposta, spero che non sia troppo
difficile e lungo da fare lo script che ho richiesto
e spero di trovare qualcuno che abbia il tempo ed
anche la voglia per farlo,
per me è sempre un piacere seguirvi e leggervi
in questo forum

ciao

skygirl · 28 Gennaio 2017

Ciao a tutti ho questa lunghetta 17.44.35.67.88.78 ho applicato lo script del post #6
questo l'output
[IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/funkyimg.com\/i\/2nYqX.jpg"}[/IMG2]
[IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/funkyimg.com\/i\/2nYr2.jpg"}[/IMG2]

chi mi puoi spiegare il significato di RP1.....RP10 e di SM RP e MD RP

interpretando l'output quale indicazione si può ricavare dallo script su quale possa essere la ruota favorita per esito Ambo o Terno?

thanks
un saluto

skygirl · 29 Gennaio 2017

skygirl;n2040832 ha scritto:
Ciao a tutti ho questa lunghetta 17.44.35.67.88.78 ho applicato lo script del post #6
questo l'output [IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/funkyimg.com\/i\/2nYqX.jpg"}[/IMG2]
[IMG2=JSON]{"data-align":"none","data-size":"full","src":"http:\/\/funkyimg.com\/i\/2nYr2.jpg"}[/IMG2]

chi mi puoi spiegare il significato di RP1.....RP10 e di SM RP e MD RP

interpretando l'output quale indicazione si può ricavare dallo script su quale possa essere la ruota favorita per esito Ambo o Terno?

thanks
un saluto

uscito il 44.17 VE
ma non saprei quale elemento dello script avrebbe potuto portare a preferire VE sulle altre ruote

Mike58 · 29 Gennaio 2017

Ciao SkyGirl, lo script postato elenca la statistica tradizionale con tutti i parametri canonici di una combinazione inserita anche ritardo di posizione.
Poi in aggiunta ci sono anche i 10 ritardi precedenti (RP1,RP10) in ultimo la somma ritardi SMRP e la Media Ritardi MDRP, quali parametri ed elementi preferire e per quale Ruota sta alla tua visione.

Ciao

skygirl · 30 Gennaio 2017

Mike58 adesso mi è tutto chiaro

un saluto

skygirl · 30 Gennaio 2017

Proviamo ad esaminare sempre con lo script di Mike58 questa nuova lunghetta 06.16.38.48.49.63.75.82

notiamo che in corrispondenza della ruota di PA il ritardo attuale è di 110 e il ritardo storico di 111
vediamo se uscirà l'ambo dove andrà a cadere

ppaaoolloo · 30 Gennaio 2017

ciao
è molto buono lo script di Mike (che già avevo),
ma quello che chiedevo io era una cosa molto diversa,
cioè io vorrei che inserendo ad esempio 30 o 40 numeri da me scelti
lo script mi dia la possibilità di calcolare lunghette
in cinquine o sestine oppure settine di questi 30 o 40 numeri
con il loro ritardo proprio come proponeva l'ottimo script di Luigi

spero che qualche bravo scripter riesca

grazie

salutoni

Mike58 · 30 Gennaio 2017

Paolo, io lo script di luigi non l'ho elaborato ma avrei questo script che potrebbe fare quello che vorresti ottenere.

Modifica da solo i parametri di ricerca Ini.Fin e la classe di sviluppo.

vedi se fa al caso tuo.

Codice:

Sub Main

 Dim k,s,ss
 Dim nClasse,nColonneTot
 ReDim aNumeri(90),ru(1)
 Dim aCol
 Ini = EstrazioneFin - 200
 fin = EstrazioneFin
 Tot = fin - Ini
 nClasse = 5 ' sviluppo in ambi
 ' inizializzo i numeri da sviluppare in questo caso 90
 ' ma potrebbero essere anche di meno

 ru(1) = 1
 ScegliNumeri(aNumeri)
 Scrivi "Numeri scelti : " & StringaNumeri(aNumeri),1
 Scrivi "Ruota di : " & NomeRuota(1),1
 Scrivi
 k = k + 1
 'inizializza lo sviluppo
 nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
 k = 0

 ' ciclo che continua fiono a quando le colonne non finiscono
 Do While GetCombSviluppo(aCol)

  k = k + 1 ' conteggio colonna corrente
  Call StatisticaFormazioneTurbo(aCol,ru,2,rerit,remax,Incr,refre,Ini,fin)
  ' costruisco la stringa che contiene la colonna
  s = FormatSpace(k,10,True) & ")  " & StringaNumeri(aCol,,1)
  ss =(FormatSpace(rerit,3) & "  " & " Freq..." & FormatSpace(refre,3))
  Call Scrivi((s) & "   Rit... " &(ss),0,0)
  If rerit < Tot Then Scrivi "    - " & StringaEstratti(fin - rerit,1)
  If rerit >= Tot Then Scrivi "      -- -- -- -- -- "
  'Scrivi


  Call Messaggio("Colonna " & k)
  If ScriptInterrotto Then Exit Do

 Loop
End Sub

chicco3 · 30 Gennaio 2017

Ciao mike mi riallaccio allo script che hai dato a Paolo, è un ottimo script puoi modificarlo con la ricerca delle seguenti formazioni:
- ambi diametrali;
-terzine simmetriche;
-cinquine pentagonali;
-sestine esagonali;
-cadenze;
-figure

ovviamente va bene ritardo e frequenza, se è possibile in ordine di freq e ritardo maggiore. grazie x il momento chicco3

ppaaoolloo · 31 Gennaio 2017

ciao Mike
è per me un grande piacere ritrovarti e leggerti
su questo forum, lo script mi sembra molto buono
e fa quello che chiedevo io variando come hai ben
suggerito tu la classe di sviluppo.
l'unica cosa che ti chiederei, sempre se ti è possibile,
è farlo come i tuoi molti script in formato excel, in modo
che si possa utilizzarlo in ordine decrescente per ritardo.

grazie

ciao

Mike58 · 31 Gennaio 2017

ciao Mike
è per me un grande piacere ritrovarti e leggerti
su questo forum, lo script mi sembra molto buono
e fa quello che chiedevo io variando come hai ben
suggerito tu la classe di sviluppo.
l'unica cosa che ti chiederei, sempre se ti è possibile,
è farlo come i tuoi molti script in formato excel, in modo
che si possa utilizzarlo in ordine decrescente per ritardo.

grazie

ciao

Ciao Paolo, purtroppo non sarebbe possibile farlo in tabella per un solo motivo c'è un limite di Q.tà per le righe e le elaborazioni andrebbero in errore.

Penso che si possa ovviare mettendo la frequenza o ritardo come NumeroVettore in modo da utilizzare il codice OrdinaMatrice in modo poi da ordinarlo dal alto al basso o viceversa.

Purtroppo tempo e voglia mancano se riesco non mancherò di postarlo, ma penso ti debba accontentare del formato Html.

Ciao mike mi riallaccio allo script che hai dato a Paolo, è un ottimo script puoi modificarlo con la ricerca delle seguenti formazioni:
- ambi diametrali;
-terzine simmetriche;
-cinquine pentagonali;
-sestine esagonali;
-cadenze;
-figure

ovviamente va bene ritardo e frequenza, se è possibile in ordine di freq e ritardo maggiore. grazie x il momento chicco3

X chicco3, non saprei penso siano 5 script diversi e bisognerebbe creare 5 Sub diverse per tipologia di richieste il chè farlo su questo script diventa complesso.

Non so,partire da questo script sicuramente non mi sembra fattibile, ma ex novo non è impossibile.

Sempre con tempo e voglia disponibili, nonché la necessaria lucidità.

Ciao a tutti.

chicco3 · 31 Gennaio 2017

Ciao Mike grazie di aver risposto sei gentilissimo se riesci a farlo ti sarei grado. L'importante che si possono inserire 20 o 30 numeri e riesce a darmi la convergenza con le formazioni sopra descritte solo le sei elencate le altre non mi interessano. Grazie e buona serata chicco 3

ppaaoolloo · 31 Gennaio 2017

Penso che si possa ovviare mettendo la frequenza o ritardo come NumeroVettore in modo da utilizzare il codice OrdinaMatrice in modo poi da ordinarlo dal alto al basso o viceversa.

Purtroppo tempo e voglia mancano se riesco non mancherò di postarlo, ma penso ti debba accontentare del formato Html.

se riesci andrebbe benone per ritardo

ti ringrazio anticipatamente

quando puoi

ciao

Mike58 · 31 Gennaio 2017

Paolo, ho fatto lo script in Tabella, questa e meglio che elabori le prime 100 combinazioni scelte sia per ritardo che per frequenza.
la riga e questa dove ho messo il limite, vedi se ti elabora con numeri maggiori.

Call CreaTabella(scelta,,,100)

di + ed essendo di fretta non posso sperimentare.

Codice:

Sub Main
 Dim k,s,ss
 Dim nClasse,nColonneTot
 ReDim aNumeri(90),ru(1)
 Dim aCol
 Dim Rerit,ReFre
 Ini = EstrazioneFin - 2000
 fin = EstrazioneFin
 Tot = fin - Ini
 r = ScegliRuota()
 scelta = CInt(InputBox("3 = Ritardo" & Chr(13) & "4 = frequenza",,3))
 nClasse = 5 ' sviluppo in ambi
 ' inizializzo i numeri da sviluppare in questo caso 90
 ' ma potrebbero essere anche di meno
 ru(1) = r
 ScegliNumeri(aNumeri)
 Scrivi "Numeri scelti : " & StringaNumeri(aNumeri),1
 Scrivi "Ruota di : " & NomeRuota(1),1
 Scrivi
 T = Array(T,"Conta","Combinazione","Ritardo","Frequenze","Estratti")
 Call InitTabella(T)
 'inizializza lo sviluppo
 nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
 'k = 0
 ' ciclo che continua fiono a quando le colonne non finiscono
 Do While GetCombSviluppo(aCol)
  k = k + 1 ' conteggio colonna corrente
  Call StatisticaFormazioneTurbo(aCol,ru,2,Rerit,remax,Incr,ReFre,Ini,fin)
  Call VerificaEsitoTurbo(aCol,ru,fin - Rerit,2,1,,,,estratti,id)
  ' costruisco la stringa che contiene la colonna
  V = Array(V,k,StringaNumeri(aCol),Rerit,ReFre,estratti)
  Call AddRigaTabella(V)
  Call Messaggio("Colonna " & k)
  If ScriptInterrotto Then Exit Do
 Loop
 Call CreaTabella(scelta,,,100)
End Sub

Per chicco come detto sopre per quello ci vuole tempo e comunque non saprei, ma non disperare.
Se con Paolo abbiamo finito poi ci provo.
Ciao

chicco3 · 31 Gennaio 2017

oK mille grazie mike

ppaaoolloo · 1 Febbraio 2017

ciao
- per Mike
ho provato lo script ma non mi va, quando parte va bene,
ma quando arriva circa ad analizzare " colonna 3900" rallenta
e poi si blocca e mi da errore
7 out of memory

- per Magia
ho provato lo script ma mi da errore segnalandolo a questa penultima riga

ScegliSorte = ScegliOpzioneMenu((aVoci,01," Scegli Tipo Sorte ") + 01

vi ringrazio per la disponibilità
ora parto per il lavoro
vi leggerò stasera al rientro

buona giornata

variazione script di Luigi per lunghette

Super Member >PLATINUM<

LuigiB

Guest

Advanced Member

LuigiB

Guest

Super Member >PLATINUM<

Advanced Member >GOLD<

Advanced Member >GOLD<

Advanced Member >PLATINUM PLUS<

Advanced Member >GOLD<

Advanced Member >GOLD<

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member

Super Member >PLATINUM<