Qualcuno può realizzare questo listato...Grazie

[solare]

Chiedo cortesemente la realizzazione di un listato che trovi
un numero della stessa decina sortito in posizione isotopa in tre estrazioni consecutive su ruota.
Grazie

 

[claudio8]

Gli script vanno sempre provati e controllati negli esiti dai richedenti.

Sub Main()
	Dim casi
	Dim am(10)
	Dim ruota(10)
	Dim posta(5)
	posta(1) = 1
	posta(2) = 1
	ini = 7500 '3861 (05/01/1945 1a estrazione a 10 ruote)
	casi = 0
	For n = ini To EstrazioneFin
		Messaggio DataEstrazione(n)
		For r = 1 To 12
                    if r=11 then r=12
			For p = 1 To 5
				 a = Decina( Estratto(n-2,r,p))
				 b = Decina(Estratto(n-1,r,p))
				 c = Decina(Estratto(n,r,p))
				 If a = b And b=c Then
				casi = casi +1

					ColoreTesto 2
					Scrivi "caso n° " & casi
					Scrivi " Estrazione positiva del " & DataEstrazione(n-2) & " decina " & a & "  su " & SiglaRuota(r) & " con " & Estratto(n-2,r,p)
					Scrivi " Estrazione positiva del " & DataEstrazione(n-1) & " decina " & b & "  su " & SiglaRuota(r) & " con " & Estratto(n-1,r,p)
					Scrivi " Estrazione positiva del " & DataEstrazione(n  ) & " decina " & c & "  su " & SiglaRuota(r) & " con " & Estratto(n,r,p)

					ColoreTesto 0
					ruota(1) = r
					am(1) = Fuori90(a+b+c)
					am(2) = ComplAdX(am(1))
				
					ImpostaGiocata 1,am,ruota,posta,10,2
					Gioca n
				End If
			Next
		Next
	Next
	ScriviResoconto
End Sub

Lo spot che conosciamo dice "Ti Piace vincere facile ? " .. io rispondo SI !!!"

 

[LuigiB]

Fatto al volo verificare se funziona.
Correzione ... mancava la data ...

Option Explicit
Sub Main
	
	Dim k , r , d , e 
	Dim nRipet ,nRipetVolute,  idEstr
	Dim Inizio , Fine 
	Dim sTmp 
	
	Inizio = EstrazioneIni
	Fine = EstrazioneFin 
	nRipetVolute = 3
	
	For k = Inizio To Fine 
		For r = 1 To 10
			For e = 1 To 5
				idEstr = k 
				d = DecinaNaturale(Estratto(idEstr,r,e))
				nRipet = 0
				sTmp =""
				If DecinaNaturale(Estratto(idEstr-1 ,r,e)) <> d Then
					Do While DecinaNaturale(Estratto(idEstr ,r,e)) = d 
						sTmp = sTmp & Estratto(idEstr ,r,e) & "."
						nRipet = nRipet +1 
						idEstr = idEstr +1
						If idEstr > Fine Then Exit Do 
					Loop
					If nRipet >= nRipetVolute Then
						Call Scrivi (GetInfoEstrazione(k))
						Call Scrivi ("Ruota  : " & NomeRuota(r))
						Call Scrivi ("Pos    : " & e )
						Call Scrivi ("Numeri : " & Left(sTmp , Len(sTmp)-1) ) 
						Call Scrivi (String (50 , "-")) 
						
						
	
					End If
				End If
							
			Next
			
		Next
		If ScriptInterrotto Then Exit For 
		Call AvanzamentoElab (Inizio , Fine, k )
		
	Next
	
End Sub

 

[claudio8]

X Luigi, prova a far girare lo script che ho postato, c'èuno strano errore sul grafico del resoconto.

errore 11 - divisione x zero

 

[LuigiB]

che versione hai ? che range hai usato ?

 

[solare]

Grazie Luigi e Claudio8

 

[claudio8]

quote:Originally posted by LuigiB

che versione hai ? che range hai usato ?

Ho la 99 .
Ho riprovato anche adesso con diversi range e ni mi ha + dato problemi, è tutto ok.
Ciao

 

[aldino]

Un buon pomeriggio a tutti

Cercavo di rimettere in gioco i tre numeri rilevati

gentilmente,quando avete tempo,mi fate vedere come si fa'??

io sono arrivato sino a qui[8D][8D][8D]

""""""""""

Option Explicit
Sub Main

Dim k,r,d,e
Dim nRipet,nRipetVolute,idEstr
Dim Inizio,Fine
Dim sTmp
Dim luigi(3),posta(2),ruota(10)
posta(1) = 1
posta(2) = 2

Inizio = 8400'EstrazioneIni
Fine = EstrazioneFin
nRipetVolute = 3

For k = Inizio To Fine
For r = 1 To 10
For e = 1 To 5
idEstr = k
d = DecinaNaturale(Estratto(idEstr,r,e))
nRipet = 0
sTmp = ""
If DecinaNaturale(Estratto(idEstr - 1,r,e)) <> d Then
Do While DecinaNaturale(Estratto(idEstr,r,e)) = d
sTmp = sTmp & Estratto(idEstr,r,e) & "."
nRipet = nRipet + 1
idEstr = idEstr + 1
If idEstr > Fine Then Exit Do
Loop
If nRipet >= nRipetVolute Then
Call Scrivi(GetInfoEstrazione(k))
Call Scrivi("Ruota : " & NomeRuota(r))
Call Scrivi("Pos : " & e)
Call Scrivi("Numeri : " & Left(sTmp,Len(sTmp) - 1))
Call Scrivi(String(50,"-"))

luigi(1) = 1'da inserire denkiu'
luigi(2) = 2'da inserire
luigi(3) = 3'da inserire


ruota(1) = r
ImpostaGiocata 1,luigi,ruota,posta,9,2
Gioca k
End If
End If

Next

Next
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(Inizio,Fine,k)

Next
ScriviResoconto
End Sub
""""""""""""""

grazie anticipato
e buon proseguimento



un saluto a tutti da aldino

 

[LuigiB]

ciao ,

Option Explicit
Sub Main
	Dim k,r,d,e
	Dim nRipet,nRipetVolute,idEstr
	Dim Inizio,Fine
	Dim sTmp
	Dim nColpiDiGioco,nSorte
	Dim nGioc 
	
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	nSorte = CInt(InputBox("Inserire serte giocata (da 1 a 5 )","Sorte","1"))
	nColpiDiGioco = CInt(InputBox("Inserire colpi di gioco","Colpi","10"))
	nRipetVolute = 3
	If nSorte > 0 And nSorte <= 5 And nColpiDiGioco > 0 Then
		For k = Inizio To Fine
			For r = 1 To 10
				For e = 1 To 5
					idEstr = k
					d = DecinaNaturale(Estratto(idEstr,r,e))
					nRipet = 0
					sTmp = ""
					If DecinaNaturale(Estratto(idEstr - 1,r,e)) <> DecinaNaturale(Estratto(idEstr,r,e)) Then
						Do While DecinaNaturale(Estratto(idEstr,r,e)) = d
							sTmp = sTmp & Estratto(idEstr,r,e) & "."
							nRipet = nRipet + 1
							idEstr = idEstr + 1
							If idEstr > Fine Then Exit Do
						Loop
						
						
						
						If nRipet >= nRipetVolute Then
						
							sTmp = Left(sTmp,Len(sTmp) - 1)
							Call Scrivi("Estrzione  : " & GetInfoEstrazione(k))
							Call Scrivi("Ruota      : " & NomeRuota(r))
							Call Scrivi("Pos        : " & e)
							Call Scrivi("Numeri     : " & sTmp )
							Call Scrivi(String(50,"-"))
							Call Scrivi ("")
							
							nGioc = nGioc +1 
							ReDim aN(0)
							Call SplitByChar(sTmp,".",aN)
							ReDim aRuote(1)
							aRuote(1) = r
							ReDim aPoste(nSorte)
							aPoste(nSorte) = 1
							Call ImpostaGiocata(nGioc,aN,aRuote,aPoste,nColpiDiGioco ,nSorte)
							
							Call Gioca ( idEstr-1)
						End If
					End If
				Next
			Next
			If ScriptInterrotto Then Exit For
			Call AvanzamentoElab(Inizio,Fine,k)
		Next
		
		Call ScriviResoconto 
	Else
		MsgBox "Parametri di gioco mancanti",vbExclamation
	End If
End Sub

 

[aldino]

Elementare, Watson

Grazie ,LuigiB

Nel chiedere scusa a solare x l'intromissione ne approfitto

altresi per complimentarmi per l'originalita' di questa ricerca.

Ho fatto qualche prova .
I risultati sono incoraggianti e , nel caso la ricerca venga fatta per "CADENZA" , ci sono esiti di ambo in terzina.

Ancora grazie e buon proseguimento

un saluto a tutti da aldino

 

[Roberto02]

quote:Originally posted by aldino

Elementare, Watson

Grazie ,LuigiB

Nel chiedere scusa a solare x l'intromissione ne approfitto

altresi per complimentarmi per l'originalita' di questa ricerca.

Ho fatto qualche prova .
I risultati sono incoraggianti e , nel caso la ricerca venga fatta per "CADENZA" , ci sono esiti di ambo in terzina.

Ancora grazie e buon proseguimento

un saluto a tutti da aldino

Buongiorno al forum ed un sentito ringraziamento per le numerose applicazioni e script messi a disposizione. Interessante l'osservazione delle cadenze, che da tempo "sperimento"...vediamo un poco uno spunto:

listare uno script che estrapoli un terno in cadenza

* prendere la cadenza dei 3 numeri usciti e giocarla per estratto determinato, sulle 2 posizioni rimanenti,

In tal modo, si giocherebbero 9 numeri per 2 posizioni (2 euro di spesa per 6 di guadagno) anche se sembra poco, sono equivalenti al gioco di ambata in terzina, o di ambo in cinquina a tutte (e quanti si "vantano" di prendere ambi in cinquina a tutte le ruote)

* prendere i 3 numeri estratti (in genere uno si ripete), e usarli come capogiochi per i +10 -10 di ogni singolo numero (laterali in cadenza)...otterremmo al max una sestina o una quartina a ruota...

* prendere i 3 numeri estratti e giocarli per ambo e terno a tutte le ruote (cabalistico)

Sono benvenute idee in proposito...

Grazie e buona giornata a tutte/i

Roberto