Per Gli Amanti della Tavola Settenaria (In Tabella)
 
Pagina 1 di 5 123 ... ultimoultimo
Visualizzazione dei risultati da 1 a 10 su 41

Discussione: Per Gli Amanti della Tavola Settenaria (In Tabella)

  1. #1
    Blackmore
    Guest

    Per Gli Amanti della Tavola Settenaria (In Tabella)

    Hola... premetto che lo script è stato solo un passatempo
    anche perchè non sono un grande amante delle Tavole in generale
    ma in questo periodo le Tabelle sono la mia passione
    Il listato, oltre a mostrare la tabella, mette in gioco una previsione
    per ambata e cinquina (giusto per giocare qualcosa) su indice mensile a scelta
    divertitevi tramite le inputbox a cercare le ruote migliori
    o l'estratto spia in posizione migliore
    Vedete Il tutto come un bel giochino e nulla piu'
    PS: GIRA SOLO SU SPAZIOMETRIA (1.4.50)

    Ciao



    codice:
    Sub Main()
    	Dim ruota(10),ambata(1),lg(5),posta(1),poste(3)
    	posta(1) = 1 : poste(2) = 1 : poste(3) = 1
    	S = " TABELLA  TAVOLA  SETTENARIA CON ANNESSA GIOCATA BY  BLACKMORE "
    	T = " IN FONDO AL LISTATO (SOTTO LA TAVOLA) TROVATE IL RESOCONTO    "
    	Scrivi S,1,,vbBlue,5,3 :Scrivi T,1,,vbRed,5,3:Scrivi
    	im = CInt(InputBox("INDICE  MENSILE ? (INSERISCI 0 PER L' ULTIMA)","BLACKMORE",0))
    	r = CInt(InputBox("SCEGLI  LA  RUOTA  DI  RICERCA " & Chr(13) & "QUESTA E' ANCHE  LA  1° RUOTA  GIOCO","BLACKMORE",1))
    	rr = CInt(InputBox("SCEGLI  LA  2° RUOTA  DI  GIOCO","BLACKMORE",6))
    	pos = CInt(InputBox("SCEGLI  LA  POSIZIONE  DELL' ESTRATTO","BLACKMORE",4))
    	k = InputBox("COLPI  DI  GIOCO ?","BLACKMORE",10)
    	Ini = InputBox("INIZIO  RICERCA  ESTRAZIONE N° ?","BLACKMORE",8400)
    	ReDim at(37)
    	at(01) = ""
    	at(02) = ""
    	at(03) = ""
    	at(04) = ""
    	at(05) = ""
    	at(06) = ""
    	at(07) = ""
    	at(08) = ""
    	at(09) = ""
    	at(10) = ""
    	at(12) = ""
    	at(13) = ""
    	at(14) = ""
    	at(15) = ""
    	at(16) = ""
    	at(17) = ""
    	at(18) = ""
    	at(19) = ""
    	at(20) = ""
    	at(21) = ""
    	at(22) = ""
    	at(23) = ""
    	at(24) = ""
    	at(25) = ""
    	at(26) = ""
    	at(27) = ""
    	at(28) = ""
    	at(29) = ""
    	at(30) = ""
    	at(31) = ""
    	at(32) = ""
    	at(33) = ""
    	at(34) = ""
    	at(35) = ""
    	at(37) = ""
    	Call InitTabella(at,1,,1,5,"Arial black")
    	For x = 1 To 10
    		a = Fuori90(x*13)
    		b = 91 - a
    		c = Fuori90(x*7)
    		d = 91 - x
    		x1 = x + 10
    		a1 = Fuori90(x1*13)
    		b1 = 91 - a1
    		c1 = Fuori90(x1*7)
    		d1 = 91 - x1
    		x2 = x + 20
    		a2 = Fuori90(x2*13)
    		b2 = 91 - a2
    		c2 = Fuori90(x2*7)
    		d2 = 91 - x2
    		x3 = x + 30
    		a3 = Fuori90(x3*13)
    		b3 = 91 - a3
    		c3 = Fuori90(x3*7)
    		d3 = 91 - x3
    		x4 = x + 40
    		a4 = Fuori90(x4*13)
    		b4 = 91 - a4
    		c4 = Fuori90(x4*7)
    		d4 = 91 - x4
    		x5 = x + 50
    		a5 = Fuori90(x5*13)
    		b5 = 91 - a5
    		c5 = Fuori90(x5*7)
    		d5 = 91 - x5
    		x6 = x + 60
    		a6 = Fuori90(x6*13)
    		b6 = 91 - a6
    		c6 = Fuori90(x6*7)
    		d6 = 91 - x6
    		x7 = x + 70
    		a7 = Fuori90(x7*13)
    		b7 = 91 - a7
    		c7 = Fuori90(x7*7)
    		d7 = 91 - x7
    		x8 = x + 80
    		a8 = Fuori90(x8*13)
    		b8 = 91 - a8
    		c8 = Fuori90(x8*7)
    		d8 = 91 - x8
    		fin = EstrazioneFin
    		For es = Ini To fin
    			Call AvanzamentoElab(Ini,fin,es)
    			Messaggio "TABELLA  SETTENARIA  CON  ANNESSA  GIOCATA  -  BY BLACKMORE  -"
    			ultest = EstrazioneFin
    			If(((eval(im) = 0)And(es = ultest))Or((IndiceMensile(es) = eval(im)And(eval(im) > 0))Or((IndiceMensile(es + 1) = 1)And(eval(im) = 0)))) Then
    				If aa = x Or a = x1 Or a = x2 Or a = x3 Or a = x4 Or a = x5 Or a = x6 Or a = x7 Or a = x8 Then
    					ruota(1) = r : ruota(2) = rr
    					aa = Estratto(es,r,pos)
    					co = co + 1
    					Scrivi String(86,"*") & " Caso n°" & Format2(co),1,,,,3
    					Scrivi DataEstrazione(es) & "  " & SiglaRuota(r) & "  " & StringaEstratti(es,r) & "  -->  " & Format2(aa) & " In " & pos & "° Posizione",1,,1,5,3
    					ambata(1) = aa
    					ImpostaGiocata 1,ambata,ruota,posta,k,1
    					lg(1) = aa
    					lg(2) = Fuori90(aa*13)
    					lg(3) = 91 - lg(2)
    					lg(4) = Fuori90(aa*7)
    					lg(5) = 91 - aa
    					ImpostaGiocata 2,lg,ruota,poste,k,2
    					Gioca es,1
    				End If
    			End If
    		Next
    		ReDim av(37)
    		av(01) = ""
    		av(02) = " " & Format2(a) & "       " & Format2(b)
    		av(03) = "    " & FormatSpace(x,5)
    		av(04) = " " & Format2(c) & "       " & Format2(d)
    		av(05) = ""
    		av(06) = " " & Format2(a1) & "      " & Format2(b1)
    		av(07) = "    " & FormatSpace(x1,5)
    		av(08) = " " & Format2(c1) & "       " & Format2(d1)
    		av(09) = ""
    		av(10) = " " & Format2(a2) & "      " & Format2(b2)
    		av(11) = "    " & FormatSpace(x2,5)
    		av(12) = " " & Format2(c2) & "      " & Format2(d2)
    		av(13) = ""
    		av(14) = " " & Format2(a3) & "       " & Format2(b3)
    		av(15) = "    " & FormatSpace(x3,5)
    		av(16) = " " & Format2(c3) & "       " & Format2(d3)
    		av(17) = ""
    		av(18) = " " & Format2(a4) & "       " & Format2(b4)
    		av(19) = "    " & FormatSpace(x4,5)
    		av(20) = " " & Format2(c4) & "       " & Format2(d4)
    		av(21) = ""
    		av(22) = " " & Format2(a5) & "       " & Format2(b5)
    		av(23) = "    " & FormatSpace(x5,5)
    		av(24) = " " & Format2(c5) & "       " & Format2(d5)
    		av(25) = ""
    		av(26) = " " & Format2(a6) & "       " & Format2(b6)
    		av(27) = "    " & FormatSpace(x6,5)
    		av(28) = " " & Format2(c6) & "       " & Format2(d6)
    		av(29) = ""
    		av(30) = " " & Format2(a7) & "       " & Format2(b7)
    		av(31) = "    " & FormatSpace(x7,5)
    		av(32) = " " & Format2(c7) & "       " & Format2(d7)
    		av(33) = ""
    		av(34) = " " & Format2(a8) & "       " & Format2(b8)
    		av(35) = "    " & FormatSpace(x8,5)
    		av(36) = " " & Format2(c8) & "       " & Format2(d8)
    		av(37) = ""
    		Call AddRigaTabella(av,,,2,,"arial black")
    		Call SetColoreCella(1,1)
    		Call SetColoreCella(5,1)
    		Call SetColoreCella(9,1)
    		Call SetColoreCella(13,1)
    		Call SetColoreCella(17,1)
    		Call SetColoreCella(21,1)
    		Call SetColoreCella(25,1)
    		Call SetColoreCella(29,1)
    		Call SetColoreCella(33,1)
    		Call SetColoreCella(37,1)
    		Call SetColoreCella(2,0,5)
    		Call SetColoreCella(3,0,2)
    		Call SetColoreCella(4,0,5)
    		Call SetColoreCella(6,0,5)
    		Call SetColoreCella(7,0,2)
    		Call SetColoreCella(8,0,5)
    		Call SetColoreCella(10,0,5)
    		Call SetColoreCella(11,0,2)
    		Call SetColoreCella(12,0,5)
    		Call SetColoreCella(14,0,5)
    		Call SetColoreCella(15,0,2)
    		Call SetColoreCella(16,0,5)
    		Call SetColoreCella(18,0,5)
    		Call SetColoreCella(19,0,2)
    		Call SetColoreCella(20,0,5)
    		Call SetColoreCella(22,0,5)
    		Call SetColoreCella(23,0,2)
    		Call SetColoreCella(24,0,5)
    		Call SetColoreCella(26,0,5)
    		Call SetColoreCella(27,0,2)
    		Call SetColoreCella(28,0,5)
    		Call SetColoreCella(30,0,5)
    		Call SetColoreCella(31,0,2)
    		Call SetColoreCella(32,0,5)
    		Call SetColoreCella(34,0,5)
    		Call SetColoreCella(35,0,2)
    		Call SetColoreCella(36,0,5)
    		If x < 11 Then Call SetColoreCella(3,,2)
    		If x1 < 21 Then Call SetColoreCella(7,,2)
    		If x2 < 31 Then Call SetColoreCella(11,,2)
    		If x3 < 41 Then Call SetColoreCella(15,,2)
    		If x4 < 51 Then Call SetColoreCella(19,,2)
    		If x5 < 61 Then Call SetColoreCella(23,,2)
    		If x6 < 71 Then Call SetColoreCella(27,,2)
    		If x7 < 81 Then Call SetColoreCella(31,,2)
    		If x8 < 91 Then Call SetColoreCella(35,,2)
    		If ScriptInterrotto Then Exit For
    	Next
    	Scrivi:Scrivi
    	ReDim att(37)
    	att(37) = ""
    	Call AddRigaTabella(att,vbBlue,,0)
    	SetTableWidth("960px")
    	Call CreaTabella(0,,,,1)
    	Call ScriviResoconto(,False)
    End Sub
    Ultima modifica di Blackmore; 01-10-2013 a 11:18 Motivo: Aggiunte...

  2. #2
    Senior Member L'avatar di Schirò Gioacchino
    Registrato dal
    Jul 2009
    Messaggi
    7,001
    grazie .......er+

    La matematica, vista nella giusta luce,
    possiede non soltanto verità ma anche
    suprema bellezza.
    Una bellezza fredda e austera,
    come quella della scultura
    B.R.
    non escludo l'uscita su tutte e nazionale
    con moderazione
    nulla e dato per certo


  3. #3
    Blackmore
    Guest
    Ciao Schirò, hai ragione, adesso dovrebbe essere a posto
    Specifico una cosa che ho dimenticato di dire
    Lo script prende un estratto in una posizione a scelta e rimette in gioco
    lo stesso estratto con i restanti numeri appartenenti al quadratino
    consultare la tabella in basso allo script
    Ciao

    Per l'ultima estrazione del mese mettete 0
    Ultima modifica di Blackmore; 01-10-2013 a 11:20

  4. #4
    Senior Member L'avatar di Schirò Gioacchino
    Registrato dal
    Jul 2009
    Messaggi
    7,001
    grazie x l'intervento ..........ti volevo chiederti se era possibbile inserire la cella a piacere
    cioeee invece degli 4 numeri di appartenenza all'estratto sortito magari una cella diversa?
    oppure 4 numeri diversi

    La matematica, vista nella giusta luce,
    possiede non soltanto verità ma anche
    suprema bellezza.
    Una bellezza fredda e austera,
    come quella della scultura
    B.R.
    non escludo l'uscita su tutte e nazionale
    con moderazione
    nulla e dato per certo


  5. #5
    Blackmore
    Guest
    Ho inserito un inputbox dove tu scegli il numero della cella
    e lo script ti da i 4 abbinamenti della cella inserita
    per sicurezza controlla

    codice:
    Sub Main()
    	Dim ruota(10),ambata(1),lg(5),posta(1),poste(3)
    	posta(1) = 1 : poste(2) = 1 : poste(3) = 1
    	S = " TABELLA  TAVOLA  SETTENARIA CON ANNESSA GIOCATA BY  BLACKMORE "
    	T = " IN FONDO AL LISTATO (SOTTO LA TAVOLA) TROVATE IL RESOCONTO    "
    	Scrivi S,1,,vbBlue,5,3 :Scrivi T,1,,vbRed,5,3:Scrivi
    	im = CInt(InputBox("INDICE  MENSILE ? (INSERISCI 0 PER L'ULTIMA)","BLACKMORE",0))
    	r = CInt(InputBox("SCEGLI  LA  RUOTA  DI  RICERCA " & Chr(13) & "QUESTA E' ANCHE  LA  1° RUOTA  GIOCO","BLACKMORE",1))
    	rr = CInt(InputBox("SCEGLI  LA  2° RUOTA  DI  GIOCO","BLACKMORE",6))
    	pos = CInt(InputBox("SCEGLI  LA  POSIZIONE  DELL' ESTRATTO","BLACKMORE",4))
    	esa = InputBox("INSERISCI IL NUMERO DI CELLA (DA 1 A 90.. PER I 4 ABBINAMENTI)","BLACKMORE",10)
    	k = InputBox("COLPI  DI  GIOCO ?","BLACKMORE",10)
    	Ini = InputBox("INIZIO  RICERCA  ESTRAZIONE N° ?","BLACKMORE",8400)
    	ReDim at(37)
    	at(01) = ""
    	at(02) = ""
    	at(03) = ""
    	at(04) = ""
    	at(05) = ""
    	at(06) = ""
    	at(07) = ""
    	at(08) = ""
    	at(09) = ""
    	at(10) = ""
    	at(12) = ""
    	at(13) = ""
    	at(14) = ""
    	at(15) = ""
    	at(16) = ""
    	at(17) = ""
    	at(18) = ""
    	at(19) = ""
    	at(20) = ""
    	at(21) = ""
    	at(22) = ""
    	at(23) = ""
    	at(24) = ""
    	at(25) = ""
    	at(26) = ""
    	at(27) = ""
    	at(28) = ""
    	at(29) = ""
    	at(30) = ""
    	at(31) = ""
    	at(32) = ""
    	at(33) = ""
    	at(34) = ""
    	at(35) = ""
    	at(37) = ""
    	Call InitTabella(at,1,,1,5,"Arial black")
    	For x = 1 To 10
    		a = Fuori90(x*13)
    		b = 91 - a
    		c = Fuori90(x*7)
    		d = 91 - x
    		x1 = x + 10
    		a1 = Fuori90(x1*13)
    		b1 = 91 - a1
    		c1 = Fuori90(x1*7)
    		d1 = 91 - x1
    		x2 = x + 20
    		a2 = Fuori90(x2*13)
    		b2 = 91 - a2
    		c2 = Fuori90(x2*7)
    		d2 = 91 - x2
    		x3 = x + 30
    		a3 = Fuori90(x3*13)
    		b3 = 91 - a3
    		c3 = Fuori90(x3*7)
    		d3 = 91 - x3
    		x4 = x + 40
    		a4 = Fuori90(x4*13)
    		b4 = 91 - a4
    		c4 = Fuori90(x4*7)
    		d4 = 91 - x4
    		x5 = x + 50
    		a5 = Fuori90(x5*13)
    		b5 = 91 - a5
    		c5 = Fuori90(x5*7)
    		d5 = 91 - x5
    		x6 = x + 60
    		a6 = Fuori90(x6*13)
    		b6 = 91 - a6
    		c6 = Fuori90(x6*7)
    		d6 = 91 - x6
    		x7 = x + 70
    		a7 = Fuori90(x7*13)
    		b7 = 91 - a7
    		c7 = Fuori90(x7*7)
    		d7 = 91 - x7
    		x8 = x + 80
    		a8 = Fuori90(x8*13)
    		b8 = 91 - a8
    		c8 = Fuori90(x8*7)
    		d8 = 91 - x8
    		fin = EstrazioneFin
    		For es = Ini To fin
    			Call AvanzamentoElab(Ini,fin,es)
    			Messaggio "TABELLA  SETTENARIA  CON  ANNESSA  GIOCATA  -  BY BLACKMORE  -"
    			ultest = EstrazioneFin
    			If(((eval(im) = 0)And(es = ultest))Or((IndiceMensile(es) = eval(im)And(eval(im) > 0))Or((IndiceMensile(es + 1) = 1)And(eval(im) = 0)))) Then
    				If aa = x Or a = x1 Or a = x2 Or a = x3 Or a = x4 Or a = x5 Or a = x6 Or a = x7 Or a = x8 Then
    					ruota(1) = r : ruota(2) = rr
    					aa = Estratto(es,r,pos)
    					
    					co = co + 1
    					Scrivi String(86,"*") & " Caso n°" & Format2(co),1,,,,3
    					Scrivi DataEstrazione(es) & "  " & SiglaRuota(r) & "  " & StringaEstratti(es,r) & "  -->  " & Format2(aa) & " In " & pos & "° Posizione",1,,1,5,3
    					ambata(1) = aa
    					ImpostaGiocata 1,ambata,ruota,posta,k,1
    					lg(1) = aa
    					lg(2) = Fuori90(esa*13)
    					lg(3) = 91 - lg(2)
    					lg(4) = Fuori90(esa*7)
    					lg(5) = 91 - esa
    					ImpostaGiocata 2,lg,ruota,poste,k,2
    					Gioca es,1
    				End If
    			End If
    		Next
    		ReDim av(37)
    		av(01) = ""
    		av(02) = " " & Format2(a) & "       " & Format2(b)
    		av(03) = "    " & FormatSpace(x,5)
    		av(04) = " " & Format2(c) & "       " & Format2(d)
    		av(05) = ""
    		av(06) = " " & Format2(a1) & "      " & Format2(b1)
    		av(07) = "    " & FormatSpace(x1,5)
    		av(08) = " " & Format2(c1) & "       " & Format2(d1)
    		av(09) = ""
    		av(10) = " " & Format2(a2) & "      " & Format2(b2)
    		av(11) = "    " & FormatSpace(x2,5)
    		av(12) = " " & Format2(c2) & "      " & Format2(d2)
    		av(13) = ""
    		av(14) = " " & Format2(a3) & "       " & Format2(b3)
    		av(15) = "    " & FormatSpace(x3,5)
    		av(16) = " " & Format2(c3) & "       " & Format2(d3)
    		av(17) = ""
    		av(18) = " " & Format2(a4) & "       " & Format2(b4)
    		av(19) = "    " & FormatSpace(x4,5)
    		av(20) = " " & Format2(c4) & "       " & Format2(d4)
    		av(21) = ""
    		av(22) = " " & Format2(a5) & "       " & Format2(b5)
    		av(23) = "    " & FormatSpace(x5,5)
    		av(24) = " " & Format2(c5) & "       " & Format2(d5)
    		av(25) = ""
    		av(26) = " " & Format2(a6) & "       " & Format2(b6)
    		av(27) = "    " & FormatSpace(x6,5)
    		av(28) = " " & Format2(c6) & "       " & Format2(d6)
    		av(29) = ""
    		av(30) = " " & Format2(a7) & "       " & Format2(b7)
    		av(31) = "    " & FormatSpace(x7,5)
    		av(32) = " " & Format2(c7) & "       " & Format2(d7)
    		av(33) = ""
    		av(34) = " " & Format2(a8) & "       " & Format2(b8)
    		av(35) = "    " & FormatSpace(x8,5)
    		av(36) = " " & Format2(c8) & "       " & Format2(d8)
    		av(37) = ""
    		Call AddRigaTabella(av,,,2,,"arial black")
    		Call SetColoreCella(1,1)
    		Call SetColoreCella(5,1)
    		Call SetColoreCella(9,1)
    		Call SetColoreCella(13,1)
    		Call SetColoreCella(17,1)
    		Call SetColoreCella(21,1)
    		Call SetColoreCella(25,1)
    		Call SetColoreCella(29,1)
    		Call SetColoreCella(33,1)
    		Call SetColoreCella(37,1)
    		Call SetColoreCella(2,0,5)
    		Call SetColoreCella(3,0,2)
    		Call SetColoreCella(4,0,5)
    		Call SetColoreCella(6,0,5)
    		Call SetColoreCella(7,0,2)
    		Call SetColoreCella(8,0,5)
    		Call SetColoreCella(10,0,5)
    		Call SetColoreCella(11,0,2)
    		Call SetColoreCella(12,0,5)
    		Call SetColoreCella(14,0,5)
    		Call SetColoreCella(15,0,2)
    		Call SetColoreCella(16,0,5)
    		Call SetColoreCella(18,0,5)
    		Call SetColoreCella(19,0,2)
    		Call SetColoreCella(20,0,5)
    		Call SetColoreCella(22,0,5)
    		Call SetColoreCella(23,0,2)
    		Call SetColoreCella(24,0,5)
    		Call SetColoreCella(26,0,5)
    		Call SetColoreCella(27,0,2)
    		Call SetColoreCella(28,0,5)
    		Call SetColoreCella(30,0,5)
    		Call SetColoreCella(31,0,2)
    		Call SetColoreCella(32,0,5)
    		Call SetColoreCella(34,0,5)
    		Call SetColoreCella(35,0,2)
    		Call SetColoreCella(36,0,5)
    		If x < 11 Then Call SetColoreCella(3,,2)
    		If x1 < 21 Then Call SetColoreCella(7,,2)
    		If x2 < 31 Then Call SetColoreCella(11,,2)
    		If x3 < 41 Then Call SetColoreCella(15,,2)
    		If x4 < 51 Then Call SetColoreCella(19,,2)
    		If x5 < 61 Then Call SetColoreCella(23,,2)
    		If x6 < 71 Then Call SetColoreCella(27,,2)
    		If x7 < 81 Then Call SetColoreCella(31,,2)
    		If x8 < 91 Then Call SetColoreCella(35,,2)
    		If ScriptInterrotto Then Exit For
    	Next
    	Scrivi:Scrivi
    	ReDim att(37)
    	att(37) = ""
    	Call AddRigaTabella(att,vbBlue,,0)
    	SetTableWidth("960px")
    	Call CreaTabella(0,,,,1)
    	Call ScriviResoconto(,False)
    End Sub

  6. #6
    Senior Member L'avatar di Schirò Gioacchino
    Registrato dal
    Jul 2009
    Messaggi
    7,001
    grazie blak per la tempistica ,
    si era proprio cosi
    ma forse era meglio modificare la tavola inserendo i quatro numeri da mettere in gioco
    senza fare i calcoli *7o *13
    direttamente va a prendere i 4 numeri nella cella sul numero estratto
    i numeri gia li ho fatti calcolare con la penna e carta se vuoi ti inserisco le 90 celle

    La matematica, vista nella giusta luce,
    possiede non soltanto verità ma anche
    suprema bellezza.
    Una bellezza fredda e austera,
    come quella della scultura
    B.R.
    non escludo l'uscita su tutte e nazionale
    con moderazione
    nulla e dato per certo


  7. #7
    Senior Member L'avatar di Schirò Gioacchino
    Registrato dal
    Jul 2009
    Messaggi
    7,001
    scusa black ho invaso il campo non volendo ho usufruito della tua bonta chiedo vena e lascia stare
    grazie

    La matematica, vista nella giusta luce,
    possiede non soltanto verità ma anche
    suprema bellezza.
    Una bellezza fredda e austera,
    come quella della scultura
    B.R.
    non escludo l'uscita su tutte e nazionale
    con moderazione
    nulla e dato per certo


  8. #8
    Blackmore
    Guest
    Se ho capito bene, bisognerebbe inserire direttamente i numeri nella tabella
    ma questo diventerebbe un problema visto che il listato sarebbe almeno il triplo di adesso
    e piu' complesso
    invece inserendo un semplice ciclo for per un quadrato, me ne escono 10 in sequenza
    e con 4 calcoli gestisco il tutto
    Ho inserito un altra variante, la solita ambata + 4 numeri da inserire a piacimento
    PS: tranquillo, nessun disturbo
    Ciao



    codice:
    Sub Main()
    	Dim ruota(10),ambata(1),lg(5),posta(1),poste(3)
    	posta(1) = 1 : poste(2) = 1 : poste(3) = 1
    	S = " TABELLA  TAVOLA  SETTENARIA CON ANNESSA GIOCATA BY  BLACKMORE "
    	T = " IN FONDO AL LISTATO (SOTTO LA TAVOLA) TROVATE IL RESOCONTO    "
    	Scrivi S,1,,vbBlue,5,3 :Scrivi T,1,,vbRed,5,3:Scrivi
    	im = CInt(InputBox("INDICE  MENSILE ? (INSERISCI 0 PER L'ULTIMA)","BLACKMORE",0))
    	r = CInt(InputBox("SCEGLI  LA  RUOTA  DI  RICERCA " & Chr(13) & "QUESTA E' ANCHE  LA  1° RUOTA  GIOCO","BLACKMORE",1))
    	rr = CInt(InputBox("SCEGLI  LA  2° RUOTA  DI  GIOCO","BLACKMORE",6))
    	pos = CInt(InputBox("SCEGLI  LA  POSIZIONE  DELL' ESTRATTO","BLACKMORE",4))
    	n1 = InputBox("INSERISCI IL 1° ABBINAMENTO)","BLACKMORE",10)
    	n2 = InputBox("INSERISCI IL 2° ABBINAMENTO)","BLACKMORE",20)
    	n3 = InputBox("INSERISCI IL 3° ABBINAMENTO)","BLACKMORE",30)
    	n4 = InputBox("INSERISCI IL 4° ABBINAMENTO)","BLACKMORE",40)
    	k = InputBox("COLPI  DI  GIOCO ?","BLACKMORE",10)
    	Ini = InputBox("INIZIO  RICERCA  ESTRAZIONE N° ?","BLACKMORE",8400)
    	ReDim at(37)
    	at(01) = ""
    	at(02) = ""
    	at(03) = ""
    	at(04) = ""
    	at(05) = ""
    	at(06) = ""
    	at(07) = ""
    	at(08) = ""
    	at(09) = ""
    	at(10) = ""
    	at(12) = ""
    	at(13) = ""
    	at(14) = ""
    	at(15) = ""
    	at(16) = ""
    	at(17) = ""
    	at(18) = ""
    	at(19) = ""
    	at(20) = ""
    	at(21) = ""
    	at(22) = ""
    	at(23) = ""
    	at(24) = ""
    	at(25) = ""
    	at(26) = ""
    	at(27) = ""
    	at(28) = ""
    	at(29) = ""
    	at(30) = ""
    	at(31) = ""
    	at(32) = ""
    	at(33) = ""
    	at(34) = ""
    	at(35) = ""
    	at(37) = ""
    	Call InitTabella(at,1,,1,5,"Arial black")
    	For x = 1 To 10
    		a = Fuori90(x*13)
    		b = 91 - a
    		c = Fuori90(x*7)
    		d = 91 - x
    		x1 = x + 10
    		a1 = Fuori90(x1*13)
    		b1 = 91 - a1
    		c1 = Fuori90(x1*7)
    		d1 = 91 - x1
    		x2 = x + 20
    		a2 = Fuori90(x2*13)
    		b2 = 91 - a2
    		c2 = Fuori90(x2*7)
    		d2 = 91 - x2
    		x3 = x + 30
    		a3 = Fuori90(x3*13)
    		b3 = 91 - a3
    		c3 = Fuori90(x3*7)
    		d3 = 91 - x3
    		x4 = x + 40
    		a4 = Fuori90(x4*13)
    		b4 = 91 - a4
    		c4 = Fuori90(x4*7)
    		d4 = 91 - x4
    		x5 = x + 50
    		a5 = Fuori90(x5*13)
    		b5 = 91 - a5
    		c5 = Fuori90(x5*7)
    		d5 = 91 - x5
    		x6 = x + 60
    		a6 = Fuori90(x6*13)
    		b6 = 91 - a6
    		c6 = Fuori90(x6*7)
    		d6 = 91 - x6
    		x7 = x + 70
    		a7 = Fuori90(x7*13)
    		b7 = 91 - a7
    		c7 = Fuori90(x7*7)
    		d7 = 91 - x7
    		x8 = x + 80
    		a8 = Fuori90(x8*13)
    		b8 = 91 - a8
    		c8 = Fuori90(x8*7)
    		d8 = 91 - x8
    		fin = EstrazioneFin
    		For es = Ini To fin
    			Call AvanzamentoElab(Ini,fin,es)
    			Messaggio "TABELLA  SETTENARIA  CON  ANNESSA  GIOCATA  -  BY BLACKMORE  -"
    			ultest = EstrazioneFin
    			If(((eval(im) = 0)And(es = ultest))Or((IndiceMensile(es) = eval(im)And(eval(im) > 0))Or((IndiceMensile(es + 1) = 1)And(eval(im) = 0)))) Then
    				If aa = x Or a = x1 Or a = x2 Or a = x3 Or a = x4 Or a = x5 Or a = x6 Or a = x7 Or a = x8 Then
    					ruota(1) = r : ruota(2) = rr
    					aa = Estratto(es,r,pos)
    					
    					co = co + 1
    					Scrivi String(86,"*") & " Caso n°" & Format2(co),1,,,,3
    					Scrivi DataEstrazione(es) & "  " & SiglaRuota(r) & "  " & StringaEstratti(es,r) & "  -->  " & Format2(aa) & " In " & pos & "° Posizione",1,,1,5,3
    					ambata(1) = aa
    					ImpostaGiocata 1,ambata,ruota,posta,k,1
    					lg(1) = aa
    					lg(2) = n1
    					lg(3) = n2
    					lg(4) = n3
    					lg(5) = n4
    					ImpostaGiocata 2,lg,ruota,poste,k,2
    					Gioca es,1
    				End If
    			End If
    		Next
    		ReDim av(37)
    		av(01) = ""
    		av(02) = " " & Format2(a) & "       " & Format2(b)
    		av(03) = "    " & FormatSpace(x,5)
    		av(04) = " " & Format2(c) & "       " & Format2(d)
    		av(05) = ""
    		av(06) = " " & Format2(a1) & "      " & Format2(b1)
    		av(07) = "    " & FormatSpace(x1,5)
    		av(08) = " " & Format2(c1) & "       " & Format2(d1)
    		av(09) = ""
    		av(10) = " " & Format2(a2) & "      " & Format2(b2)
    		av(11) = "    " & FormatSpace(x2,5)
    		av(12) = " " & Format2(c2) & "      " & Format2(d2)
    		av(13) = ""
    		av(14) = " " & Format2(a3) & "       " & Format2(b3)
    		av(15) = "    " & FormatSpace(x3,5)
    		av(16) = " " & Format2(c3) & "       " & Format2(d3)
    		av(17) = ""
    		av(18) = " " & Format2(a4) & "       " & Format2(b4)
    		av(19) = "    " & FormatSpace(x4,5)
    		av(20) = " " & Format2(c4) & "       " & Format2(d4)
    		av(21) = ""
    		av(22) = " " & Format2(a5) & "       " & Format2(b5)
    		av(23) = "    " & FormatSpace(x5,5)
    		av(24) = " " & Format2(c5) & "       " & Format2(d5)
    		av(25) = ""
    		av(26) = " " & Format2(a6) & "       " & Format2(b6)
    		av(27) = "    " & FormatSpace(x6,5)
    		av(28) = " " & Format2(c6) & "       " & Format2(d6)
    		av(29) = ""
    		av(30) = " " & Format2(a7) & "       " & Format2(b7)
    		av(31) = "    " & FormatSpace(x7,5)
    		av(32) = " " & Format2(c7) & "       " & Format2(d7)
    		av(33) = ""
    		av(34) = " " & Format2(a8) & "       " & Format2(b8)
    		av(35) = "    " & FormatSpace(x8,5)
    		av(36) = " " & Format2(c8) & "       " & Format2(d8)
    		av(37) = ""
    		Call AddRigaTabella(av,,,2,,"arial black")
    		Call SetColoreCella(1,1)
    		Call SetColoreCella(5,1)
    		Call SetColoreCella(9,1)
    		Call SetColoreCella(13,1)
    		Call SetColoreCella(17,1)
    		Call SetColoreCella(21,1)
    		Call SetColoreCella(25,1)
    		Call SetColoreCella(29,1)
    		Call SetColoreCella(33,1)
    		Call SetColoreCella(37,1)
    		Call SetColoreCella(2,0,5)
    		Call SetColoreCella(3,0,2)
    		Call SetColoreCella(4,0,5)
    		Call SetColoreCella(6,0,5)
    		Call SetColoreCella(7,0,2)
    		Call SetColoreCella(8,0,5)
    		Call SetColoreCella(10,0,5)
    		Call SetColoreCella(11,0,2)
    		Call SetColoreCella(12,0,5)
    		Call SetColoreCella(14,0,5)
    		Call SetColoreCella(15,0,2)
    		Call SetColoreCella(16,0,5)
    		Call SetColoreCella(18,0,5)
    		Call SetColoreCella(19,0,2)
    		Call SetColoreCella(20,0,5)
    		Call SetColoreCella(22,0,5)
    		Call SetColoreCella(23,0,2)
    		Call SetColoreCella(24,0,5)
    		Call SetColoreCella(26,0,5)
    		Call SetColoreCella(27,0,2)
    		Call SetColoreCella(28,0,5)
    		Call SetColoreCella(30,0,5)
    		Call SetColoreCella(31,0,2)
    		Call SetColoreCella(32,0,5)
    		Call SetColoreCella(34,0,5)
    		Call SetColoreCella(35,0,2)
    		Call SetColoreCella(36,0,5)
    		If x < 11 Then Call SetColoreCella(3,,2)
    		If x1 < 21 Then Call SetColoreCella(7,,2)
    		If x2 < 31 Then Call SetColoreCella(11,,2)
    		If x3 < 41 Then Call SetColoreCella(15,,2)
    		If x4 < 51 Then Call SetColoreCella(19,,2)
    		If x5 < 61 Then Call SetColoreCella(23,,2)
    		If x6 < 71 Then Call SetColoreCella(27,,2)
    		If x7 < 81 Then Call SetColoreCella(31,,2)
    		If x8 < 91 Then Call SetColoreCella(35,,2)
    		If ScriptInterrotto Then Exit For
    	Next
    	Scrivi:Scrivi
    	ReDim att(37)
    	att(37) = ""
    	Call AddRigaTabella(att,vbBlue,,0)
    	SetTableWidth("960px")
    	Call CreaTabella(0,,,,1)
    	Call ScriviResoconto(,False)
    End Sub

  9. #9
    Senior Member L'avatar di Schirò Gioacchino
    Registrato dal
    Jul 2009
    Messaggi
    7,001
    lo sapevo che sei un signore ecco il responso dell'ultima modifica

    io adesso devo andare al lavoro ma ci terrei a completarlo inserendo le quartine o trovando un'altro modo
    magari facendogli allo script i calcoli che ho fatto io
    ciaoooa e grazie
    stasera verso le 24 sono online o domanni mattina

    ************************************************** ************************************ Caso n°1787
    30.04.2013 BA 06.69.64.25.34 --> 69 In 2° Posizione
    Estrazione generatrice del pronostico 13884 [ 52 - 30/04/2013]
    G 0001
    Numeri in gioco : 69 su BA MI per Estratto
    V N. [69 ] [BA] [.. 69 .. .. ..] C. 1 Estratto 13885 [ 53 - 02/05/2013]
    Interrotta per esito verificato

    G 0002
    Numeri in gioco : 69.36.06.44.29 su BA MI per Ambo,Terno
    V N. [69.36.06.44.29 ] [MI] [36 .. 29 69 44] C. 8 Quaterna 13892 [ 60 - 18/05/2013]
    Interrotta per esito verificato



    | Prima Giocata : 8751 |
    | Ultima Giocata : 13949 |
    | Range : 5199 |
    | Casi giocab perc. : 17,234% |
    +----------------------------------------+ +----------------------------------+ +----------------------------------+ +----------------------------------+
    | RESOCONTO | | DISTRIBUZIONE ESITI | | DISTRIBUZIONE ESITI PERCENTUALI | | DISTRIBUZIONE CASI |
    +----------------------------------------+ +----------------------------------+ +----------------------------------+ +----------------------------------+
    | Casi esaminati : 896 | | RT | Est | Amb | Ter | Qua | Cin | | RT | Est | Amb | Ter | Qua | Cin | | RT | Q | |
    | Casi vincenti : 681 | +----------------------------------+ +----------------------------------+ +----------------------------------+
    | Percentuale pos. : 76 % | | BA | 616| 394| 24| | | | BA |23,16|50,64|52,17| | | | BA | 3582| |
    | Pronostici totali : 1.792 | | CA | | | | | | | CA | | | | | | | CA | | |
    | Pronostici vinc. : 1.362 | | FI | | | | | | | FI | | | | | | | FI | | |
    | Percentuale pos. : 76 % | | GE | | | | | | | GE | | | | | | | GE | | |
    | Giocate in corso : 4 | | MI | 618| 384| 22| 2| | | MI |23,23|49,36|47,83| 100| | | MI | 3582| |
    | Giocate terminate : 3.578 | | NA | | | | | | | NA | | | | | | | NA | | |
    | Bollette giocate : 51.448 | | PA | | | | | | | PA | | | | | | | PA | | |
    | Bollette vincenti : 1.926 | | RO | | | | | | | RO | | | | | | | RO | | |
    | Attesa media : 13 | | TO | | | | | | | TO | | | | | | | TO | | |
    | Spesa : 80.612,00 € | | VE | | | | | | | VE | | | | | | | VE | | |
    | Vincita : 50.800,90 € | | NZ | | | | | | | NZ | | | | | | | NZ | | |
    | Guadagno : -29.811,10 € | | TT | | | | | | | TT | | | | | | | TT | | |
    | Perc. Rendimento : -36,981 % | +----------------------------------+ +----------------------------------+ +----------------------------------+
    | Mass. Esposizione : 348,00 € |
    | Estratto su ruota : 2.660 |
    | Ambo su ruota : 778 |
    | Terno su ruota : 46 |
    | Quaterna su ruota : 2

    La matematica, vista nella giusta luce,
    possiede non soltanto verità ma anche
    suprema bellezza.
    Una bellezza fredda e austera,
    come quella della scultura
    B.R.
    non escludo l'uscita su tutte e nazionale
    con moderazione
    nulla e dato per certo


  10. #10
    Blackmore
    Guest
    Ok, quando vuoi metti i calcoli e vediamo se riesco
    ad inserirli nel listato...
    spero non siano troppo complessi
    Ciao !!!

Pagina 1 di 5 123 ... ultimoultimo

Discussioni simili

  1. L'essenza della Tavola Settenaria (parte seconda)
    Da damusnostra nel forum LottoCED Forum
    Risposte: 434
    Ultimo messaggio: 02-02-2014, 14:04
  2. Da una mia interpretazione della Tavola Settenaria***RO-VE
    Da Matematico5 nel forum LottoCED Forum
    Risposte: 12
    Ultimo messaggio: 09-09-2012, 00:50
  3. Spunti per gli amanti della Tavola del Cappuccino
    Da el morisco nel forum LottoCED Forum
    Risposte: 54
    Ultimo messaggio: 11-09-2010, 21:29

Tag per questa discussione

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi
  •