Per tutti gli scriptisti

[avio]

CIAO

Option Explicit
Sub Main
Dim A(120),B(120),C(120),D(120),E(120),num(120)
Dim aPermut,cls,nRig,nCol,ruota,poste(5),clp
Dim aCol(8),idestr,Es,r1,ruote,pos
Dim A1,B1,C1,D1,E1,AA1(5)
cls = 5
clp = 1
Es = InputBox("Inserisci numero estrazione",idestr,8901)
r1 = InputBox("Inserisci numero ruota ( 1 - 10)",ruota,6)

poste(3) = 0.4
poste(4) = 0.4
poste(5) = 0.2

Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(Es,r1)
Scrivi ""
ColoreTesto 2
Scrivi "********************************************************************************************************** NUMERO ESTRATTO POSIZIONE 1"
ColoreTesto 0

For pos = 1 To 5
Messaggio pos

A1 = Estratto(Es,r1,pos)
B1 = Fuori90(A1 * 13)
C1 =(91 - B1)
D1 = Fuori90(A1 * 7)
E1 =(91 - A1)
AA1(1)=A1:AA1(2)=B1:AA1(3)=C1:AA1(4)=D1:AA1(5)=E1
EliminaRipetuti AA1
If AA1(5)<>0 Then
aCol(1) = A1
aCol(2) = B1
aCol(3) = C1
aCol(4) = D1
aCol(5) = E1

aPermut = SviluppoPermutazioni(aCol,cls)
ReDim aNumeri(cls),aCostanti(cls),aNC(cls)
For nRig = 1 To UBound(aPermut)

For nCol = 1 To cls
aNumeri(nCol) = aPermut(nRig,nCol)
aCostanti(nCol) =(15 -(nCol - 1))

aNC(nCol) = Fuori90(aNumeri(nCol) * aCostanti(nCol))


If nCol = 1 Then A(nRig) = aNC(nCol)
If nCol = 2 Then B(nRig) = aNC(nCol)
If nCol = 3 Then C(nRig) = aNC(nCol)
If nCol = 4 Then D(nRig) = aNC(nCol)
If nCol = 5 Then E(nRig) = aNC(nCol)

Next

ruote = Array(0,r1)
num(nRig) = Array(0,(A(nRig)),(B(nRig)),(C(nRig)),(D(nRig)),(E(nRig)))

EliminaRipetuti num(nRig)
ImpostaGiocata nRig,num(nRig),ruote,poste,clp,2,0
Gioca Es
Next
If pos < 5 Then
ColoreTesto 2
Scrivi "********************************************************************************************************** NUMERO ESTRATTO POSIZIONE" & " " &(pos + 1)
ColoreTesto 0
Else
End If
'Else
'MsgBox" Il numero è uguale a 15 o un suo multiplo, sviluppo non possibile"
End If
Next
ScriviResoconto
End Sub

 

[salvo50]

Non sono riuscito a capire come funziona, però funziona grazie Avio

AA1(1)=A1:AA1(2)=B1:AA1(3)=C1:AA1(4)=D1:AA1(5)=E1
EliminaRipetuti AA1
If AA1(5)<>0 Then


Joe la tua non l'ho ancora provata, ciao

 

[avio]

Non sono riuscito a capire come funziona, però funziona grazie Avio

AA1(1)=A1:AA1(2)=B1:AA1(3)=C1:AA1(4)=D1:AA1(5)=E1
EliminaRipetuti AA1
If AA1(5)<>0 Then


Joe la tua non l'ho ancora provata, ciao

ciao

se ci sono numeri doppi vengono eliminati e cosi aa1(5) diventa 0 perché non sono + 5 numeri ma 4 o 3 o 2 ecc

 

[i legend]

Ciao
Left(NomeRuota(r1),2)= SiglaRuota(r1)
Buon lavoro

 

[salvo50]

Ciao a Tutti!

L'ho chiamato - Permutazione Tavola Settenaria 1 - per l'eliminazione dei numeri doppi ho usato la soluzione di Avio perchè in tutte le prove che ho fatto è andata sempre bene, ho aggiunto la ricerca per 156 estrazioni (un anno), ho già fatto un bel po' di ricerche con la ruota di Napoli ed i risultati sono stati deludenti, ho anche cambiato la moltiplicazione con l'addizione, ho anche cambiato i numeri 15-14-13-12-11 con 7-6-5-4-3, non ho trovato riscontri solo qualche centinaio di terni e qualche quaterna ma per la mole di gioco il risultato è stato sempre negativo.

Non mi so spiegare perchè se faccio la ricerca nell'ultimo anno per 156 estrazioni lo script ci impiega 85 secondi, invece per la ricerca nelle prime estrazioni (dalla numero 2 alla 157 ) ci impiga 50 minuti, una differenza enorme, non capisco cosa cambia per lo script nel prendere le estrazioni dal 1871 al 1872 con quelle dal 2014 al 2015.

'Nome "Permutazione Tavola Settenaria 1"

'Progetto by Salvo50, script by Salvo50 con la collaborazione degli amici scripters di Lottoced

'Lo script chiede di inserire quante estrazioni indietro si devono iniziare i calcoli, e di 
'scegliere la ruota, poi per ogni estratto nella tavola settenaria sceglie un quadrettino 
'lo permuta per 120 volte e ogni permutazione la moltiplica col fuori 90 per i fissi 
'15-14-13-12-11 e fa la ricerca per 156 estrazioni (un anno) delle 600 cinquine ottenute,
'per un colpo 
Option Explicit
Sub Main
Dim A(120),B(120),C(120),D(120),E(120),num(120)
Dim aPermut,cls,nRig,nCol,ruota,poste(5),clp
Dim aCol(8),idestr,Es,r1,ruote,pos,Ini,fin
Dim A1,B1,C1,D1,E1,AA1(5)
cls = 5
clp = 1
fin = EstrazioneFin
Es = InputBox("Inserisci quante estrazione vuoi andare indietro",idestr,157)
r1 = InputBox("Inserisci numero ruota ( 1 - 10)",ruota,6)
Ini = fin - Es
poste(3) = 0.4
poste(4) = 0.4
poste(5) = 0.2

Scrivi(" Estrazione n." & Format2(Ini) & " del " & DataEstrazione(Ini)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(Ini,r1)
Scrivi ""

For Es = Ini To Ini + 156
Messaggio Es

ColoreTesto 2
Scrivi "************************************************************************************************************** NUMERO ESTRATTO POSIZIONE 1"
ColoreTesto 0
For pos = 1 To 5
A1 = Estratto(Es,r1,pos)
B1 = Fuori90(A1 * 13)
C1 =(91 - B1)
D1 = Fuori90(A1 * 7)
E1 =(91 - A1)
AA1(1) = A1:AA1(2) = B1:AA1(3) = C1:AA1(4) = D1:AA1(5) = E1
EliminaRipetuti AA1
If AA1(5) <> 0 Then
aCol(1) = A1
aCol(2) = B1
aCol(3) = C1
aCol(4) = D1
aCol(5) = E1

aPermut = SviluppoPermutazioni(aCol,cls)
ReDim aNumeri(cls),aCostanti(cls),aNC(cls)
For nRig = 1 To UBound(aPermut)
For nCol = 1 To cls
aNumeri(nCol) = aPermut(nRig,nCol)
aCostanti(nCol) =(15 -(nCol - 1))
aNC(nCol) = Fuori90(aNumeri(nCol) * aCostanti(nCol))

If nCol = 1 Then A(nRig) = aNC(nCol)
If nCol = 2 Then B(nRig) = aNC(nCol)
If nCol = 3 Then C(nRig) = aNC(nCol)
If nCol = 4 Then D(nRig) = aNC(nCol)
If nCol = 5 Then E(nRig) = aNC(nCol)

Next

ruote = Array(0,r1)
num(nRig) = Array(0,(A(nRig)),(B(nRig)),(C(nRig)),(D(nRig)),(E(nRig)))

EliminaRipetuti num(nRig)
ImpostaGiocata nRig,num(nRig),ruote,poste,clp,2,0
Gioca Es
Next
If pos < 5 Then
ColoreTesto 2
Scrivi "********************************************************************************************************** NUMERO ESTRATTO POSIZIONE" & " " &(pos + 1)
ColoreTesto 0
Else
End If

End If
Next
If ScriptInterrotto Then Exit For

Next
ScriviResoconto
End Sub

 

[Joe91]

Ciao.

"non capisco cosa cambia per lo script nel prendere le estrazioni dal 1871 al 1872".

Cambia che tra le estrazioni presenti in alcune ruote, sono mancanti gli estratti di alcune altre.

Se lo script non ne tiene opportuna considerazione, è già grazia, che funzioni.

Su Spaziometria è probabile che funzioni, ma poi, gli errori sono ... tra i numeri resi dallo script,

che fonda i suoi calcoli su sequenze di zeri.

I tempi lunghi probabilmente sono quelli impiegati ad ordinare numeri uguali tra loro.

 

[avio]

L'ho chiamato - Permutazione Tavola Settenaria 1 - per l'eliminazione dei numeri doppi ho usato la soluzione di Avio perchè in tutte le prove che ho fatto è andata sempre bene, ho aggiunto la ricerca per 156 estrazioni (un anno), ho già fatto un bel po' di ricerche con la ruota di Napoli ed i risultati sono stati deludenti, ho anche cambiato la moltiplicazione con l'addizione, ho anche cambiato i numeri 15-14-13-12-11 con 7-6-5-4-3, non ho trovato riscontri solo qualche centinaio di terni e qualche quaterna ma per la mole di gioco il risultato è stato sempre negativo.

ciao

secondo me ti conviene ritornare al primo studio che hai proposto.... li la tavola è perfetta , matematica, simmetria, ecc... è una bella sfida alla perfezione

 

[salvo50]

Ciao a Tutti!

A volte quando in uno script scrivo delle istruzioni, mi appare una striscetta gialla con delle istruzioni, non faccio in tempo a leggerla tutta che sparisce, mi sono accorto che per farla riapparire devo cancellare l'istruzione e riscriverla a volte però non riappare, mi chiedevo se c'è qualche comando tipo tasto destro, sinistro, doppio clic, ecc. per richiamare questi suggerimenti.

 

[LuigiB]

ciao Salvo , la parte interessante di quella label gialla è quella scritta in grassetto che indica il paramentro da passare alla sub/function in quella determinata posizione,
Saprai che le sub e le function accettano dei parametri , i parametri sono separati da virgole , per far riapparire la label ti basta scrivere una virgola , o anche uno spazio mi pare ... essa riapparira e ti fara vedere i paramentri che lasub/function accetta e quale paramentr ogli devi passare in quella posizone (evidenziato in grassetto).
un saluto

 

[salvo50]

Quindi per farla riapparire basta mettere una virgola o uno spazio e la parte evidenziata in grassetto è quella che serve, però dato che hai scritto di sub/function (forse volevi solo fare un esempio) ti metto un immagine in un allegato per vedere se stiamo parlando della stessa cosa

 

[LuigiB]

Ciao Salvo , certo che stiamo parlando della stessa cosa , te lo dico anche senza vedere l'immgine (che tra l'altro non si vede bee perche troppo piccola )


Gli script sono composti da Sub e Function
Le sub e function possono avere dei parametri , spesso li hanno infatti
Quando tu richiami ad esempio la funzione Estratto() gli passi dei parametri .. quindi quando la scrivi nel codice l'editor per facilitarti ti fa vedere quali sono i parametri che la funzione richiede che in questo caso sono idEstrazione , Ruota , Posizione.

 

[Moro_80]

Spiegazione perfetta Luigi,
come sempre



Salvo50...le immagini belle grandi così si vedono bene.


Ciao

 

[LuigiB]

ciao Moro ero troppo pigro per mettere l'immagine ... ottimo ...cosi è ancora piu chiaro.

 

[salvo50]

Grazie a tutte e due!

Avevo fatto l'anteprima e l'allegato non lo faceva vedere, quindi prima di postare non vedevo la grandezza dell'immagine, ho messo l'allegato perchè col nuovo sistema ancora non ho capito come si mettono le immagini salvate nel computer.