Richiesta script Spaziometria per Test formula

[Matematico5]

Buon pomeriggio a tutti, chiedo gentilmente uno script per testare la seguente formula fissa :

Quando la Somma dei 5 estratti di una qualsiasi ruota fa 147

e il 1° estratto e' 1

Si metteranno in gioco :ambata 5 x ambo-terno : 77-14-5-1

Se possibile creare un imput-box x inserire anche altre somme dei 5 diverse ....e un'altro per inserire le restanti posizioni estratti .

Grazie infinite !

 

[Roby]

Ciao Matematico

Sub Main()
	Scrivi: ColoreTesto 1: Scrivi String(38," ") & " Metodo di Matematico Listato By Blackmore"
	Scrivi: ColoreTesto 0
	Dim ruota(10) : Dim ambata(1) : Dim lunghetta(5) : Dim posta(1) : Dim poste(3): Dim a1(1) : Dim b1(4)
	posta(1) = 1 : poste(2) = 1 : poste(3) = 1
	t = 0
	ss = CInt(InputBox("INSERISCI  LA  SOMMA  DEI  5  ESTRATTI",,147))
	p = CInt(InputBox("SCEGLI  LA  POSIZIONE  DELL' ESTRATTO",,1))
	j = CInt(InputBox("SCEGLI  L' ESTRATTO",,1))
	k = InputBox("INSERISCI  I  COLPI DI  GIOCO",,10)
	ff = InputBox("INSERISCI  L' AMBATA",," 5 ")
	ff = "0." & ff
	h = Split(ff,".")
	f1 = CInt(h(1))
	a1(1) = f1
	ff = InputBox("INSERISCI  LA  LUNGHETTA",," 5.1.14.77 ")
	ff = "0." & ff
	h = Split(ff,".")
	f1 = CInt(h(1)) : f2 = CInt(h(2)) : f3 = CInt(h(3)): f4 = CInt(h(4))
	b1(1) = f1 : b1(2) = f2 : b1(3) = f3 : b1(4) = f4
	ini = EstrazioneIni
	fin = EstrazioneFin
	For es = ini To fin
		Messaggio "elab. n° " & es & " del " & DataEstrazione(es) & " [ Metodo di Matematico Script By Blackmore ]"
		For r1 = 1 To 12
			If r1 = 11 Then r1 = 12
			a =(SommaEstratti(es,r1))
			b = Estratto(es,r1,p)
			If a = ss Then
				If b = j Then
					t = t + 1
					ruota(1) = r1
					Scrivi String(100,"*") & " Caso n° " & Format2(t),1
					ColoreTesto 1:Scrivi DataEstrazione(es) & "    " & SiglaRuota(r1) & "    " & StringaEstratti(es,r1) & "    " & p & "° Estratto = 1     Somma Estratti = " & a
					ColoreTesto 0: Scrivi
					ImpostaGiocata 1,a1,ruota,posta,k,1
					ImpostaGiocata 2,b1,ruota,poste,k
					Gioca es
				End If
			End If
		Next
		If ScriptInterrotto Then Exit For
	Next
	ScriviResoconto
End Sub

 

[garcid]

salve a tutti , per black o chi mi puo aiutare, vorrei chiedere se era possibile modificare il script sopra impostato, in pratica non fare la somma dei 5 estratti ma soltanto di due .
grazie saluti garcid

 

[Roby]

Imparate a fare (o modificare) questi benedetti script

Almeno quelli più semplici (come i miei)... Ciao

Sub Main()
	Scrivi: ColoreTesto 1: Scrivi String(30," ") & " Metodo di Matematico Modificato Listato By Blackmore"
	Scrivi: ColoreTesto 0
	Dim ruota(10) : Dim ambata(1) : Dim lunghetta(5) : Dim posta(1) : Dim poste(3): Dim a1(1) : Dim b1(4)
	posta(1) = 1 : poste(2) = 1 : poste(3) = 1
	t = 0
	ss = CInt(InputBox("INSERISCI  LA  SOMMA  DEI  2  ESTRATTI",,90))
	p = CInt(InputBox("SCEGLI  LA  POSIZIONE  DEL 1° ESTRATTO",,1))
	pp = CInt(InputBox("SCEGLI  LA  POSIZIONE  DEL 2° ESTRATTO",,2))
	'j = CInt(InputBox("SCEGLI  L' ESTRATTO",,1))
	k = InputBox("INSERISCI  I  COLPI DI  GIOCO",,10)
	ff = InputBox("INSERISCI  L' AMBATA",," 5 ")
	ff = "0." & ff
	h = Split(ff,".")
	f1 = CInt(h(1))
	a1(1) = f1
	ff = InputBox("INSERISCI  LA  LUNGHETTA",," 5.1.14.77 ")
	ff = "0." & ff
	h = Split(ff,".")
	f1 = CInt(h(1)) : f2 = CInt(h(2)) : f3 = CInt(h(3)): f4 = CInt(h(4))
	b1(1) = f1 : b1(2) = f2 : b1(3) = f3 : b1(4) = f4
	ini = EstrazioneFin - 500
	fin = EstrazioneFin
	For es = ini To fin
		Messaggio "elab. n° " & es & " del " & DataEstrazione(es) & " [ Metodo di Matematico Script By Blackmore ]"
		For r1 = 1 To 12
			If r1 = 11 Then r1 = 12
			a = Estratto(es,r1,p)
			b = Estratto(es,r1,pp)
			If a+b = ss Then
				'If b = j Then
					t = t + 1
					ruota(1) = r1
					Scrivi String(100,"*") & " Caso n° " & Format2(t),1
					ColoreTesto 1:Scrivi DataEstrazione(es) & "    " & SiglaRuota(r1) & "    " & StringaEstratti(es,r1) & "  Somma Dei 2 Estratti  " & a & "-" & b & " = " & ss
					ColoreTesto 0: Scrivi
					ImpostaGiocata 1,a1,ruota,posta,k,1
					ImpostaGiocata 2,b1,ruota,poste,k,2
					Gioca es
				End If
			'End If
		Next
		If ScriptInterrotto Then Exit For
	Next
	ScriviResoconto
End Sub

 

[garcid]

grazie black per la modifica , hai ragione ma se fossi capace a modificare o creare i metodi certamente farei di tutto per non disturbare nessuno ,con la età e i studi fatti è praticemente impossibile ciao e grazie