Richiesta Modifica listato x ricerca

solare · 11 Settembre 2014

Ottimo listato per ricercare 2 numeri in una ruota e un terzo su una 2 ruota, funziona x L8 ma no per spaziometria. Qualcuno può modificarlo ?

Sub Main()

Dim n(4), x(4), nu(6), am(1), ab(5), abb( 8), aabb( 8), nm(2), nr(4)
Dim vet_ru(),ruote(2), ruo1(1), ruo2(1), ruo3(1), ruota(1), post1(1), post2(2)
ruo3(1)=11
post1(1)=1
post2(2)=1
fin=EstrazioneFin
'-------------------------------------
ts1="DATA INIZIO VERIFICA ???"& Chr(13)& Chr(13)&_
"scrivere la data in formato GG.MM.AAAA"& Chr(13)&_
"separati dal *PUNTO*"&Chr(13)&Chr(13)&"Es: 01.01.2000"
a1=InputBox(ts1,,DataEstrazione(7300)) 'Inizio estrazione se scrivi 1= dal 1871
a1="0."&a1
nu1=Split(a1,".")
data1=nu1(1)&"/"&nu1(2)&"/"&nu1(3)
ini=PrimaSuccessiva (data1)
Messaggio "dal "&data1

'------------------------------------
ac="INSERIRE I TRE NUMERI DELLA DATA SPIA"&Chr(13)& Chr(13)& Chr(13)&_
"""DISTANZA 18"""& Chr(13)&_
"IN ORDINE DI DISTANZA (CIOE' 1) DISTANZA 18 (CIOE' 19) E DISTANZA 45 (CIOE' 46) QUINDI 1-19-46 ,,, 2-20-47 , Ect,Ect "&Chr(13)& Chr(13)& Chr(13)&_
"""DISTANZA 27"""& Chr(13)&_
"IN ORDINE DI DISTANZA (CIOE' 1) DISTANZA 27 (CIOE' 28) E DISTANZA 45 (CIOE' 46) QUINDI 1-28-46 ,,, 2-29-47, Ect,Ect"& Chr(13)& Chr(13)&_
"SEPARATI dal *PUNTO**Es: 01.01.01.01"
'----------------------------------------
aa=InputBox(ac,"","1.11.31")
aa="0."&aa
numeri=Split(aa,".")
For j=1 To UBound(numeri)
n(j)=CInt(numeri(j))
Next
'-------------------------------------
iruote=InputBox("Quali ruote vuoi analizzare?",,"1.2.3.4.5.6.7.8.9.10")
iruote="0."&iruote
rrr=Split(iruote,".")
qr=(UBound(rrr))
ReDim vet_ru(qr)
rigru=""
For j=1 To qr
vet_ru(j)=CInt(rrr(j))
rigru=rigru & SiglaRuota(vet_ru(j))& " "
Next

Scrivi "RICERCA EFFETTUATA SULLE RUOTE "& rigru,1

'-------------------------------------
ambt=InputBox("GIOCO L'AMBATA ???"&Chr(13)&Chr(13)&_
"1 = SI"&Chr(13)&"0 = NO",,1)
ambt=CInt(ambt)
'-------------------------------------
ci=0
ca=0
For es=ini To fin
Messaggio es
x(1)=n(1)
x(2)=n(2)
x(3)=n(3)

am(1)=Fuori90(x(1)+x(2)+x(3))
ab(1)=Fuori90(am(1)+9)
ab(2)=Fuori90(am(1)+81)
nm(1)=am(1)

cu=0
Erase nr
For ir=1 To qr '<===== prima ruota
r=vet_ru(ir)
For p=1 To 4
a=Estratto (es,r,p)
If a=x(1) Or a=x(2) Or a=x(3)Then
For q=p+1 To 5
b=Estratto (es,r,q)
If b=x(1) Or b=x(2) Or b=x(3) Then
If a=x(1) Or b=x(1) Then x(1)=0
If a=x(2) Or b=x(2) Then x(2)=0
If a=x(3) Or b=x(3) Then x(3)=0
OrdinaMatrice x,-1
For ir1=1 To qr '<===== prima ruota
r1=vet_ru(ir1)
If r1<>r And Posizione(es,r1,x(1))>0 Then
ruote(1)=r
ruote(2)=r1
ruo1(1)=r
ruo2(1)=r1
nr(1)=a
nr(2)=b
nr(3)=x(1)
nr(4)=x(2)
cu=cu+1
End If
Next 'chiude ir1
End If 'chiude If b=x(1) Or b=x(2) Or b=x(3)
Next 'chiude for q
End If ' chiude If a=x(1) Or a=x(2) Or a=x(3)
Next 'chiude for p
Next 'chiude ir

If cu=1 Then
ca=ca+1
Scrivi "'*************************************************************************************"

Scrivi FormatSpace(ca,4)&DataEstrazione(es)&" "&_
Left(NomeRuota(ruote(1)),2)&" "& Format2(nr(2))&" "& Format2(nr(1))&" "&_
Left(NomeRuota(ruote(2)),2)&" "& Format2(nr(3)),1

ColoreTesto 1
Scrivi "------------------------------------------------"
ColoreTesto 0
Scrivi "15 Estrazioni" 'estrazioni antecedenti ultima estrazione

For xx=1 To 20
ex=es-xx
ColoreTesto 0
If Posizione (ex,ruote(1),am(1))>0 Then
Scrivi Left(NomeRuota(ruote(1)),2)&" "& Format2(am(1))&_
" già sortito il "&DataEstrazione(ex)
End If
ColoreTesto 2

If Posizione (ex,ruote(2),am(1))>0 Then
Scrivi Left(NomeRuota(ruote(2)),2)&" "& Format2(am(1))&_
" già sortito il "&DataEstrazione(ex)
End If
Next
Scrivi "---------------------------------------------------------------"

Scrivi "Ambo a ruota meno 50 estrazioni" ''cerca ambo in cinquina su ruote
For kk=1 To 50 'estrazioni antecedenti ultima estrazione
ekk=es-kk
ColoreTesto 0
If SerieFreq (ekk,ekk,ab,ruo1,2)>0 Then
Scrivi DataEstrazione (ekk)&" "& Left(NomeRuota (ruo1(1)),2)&" Ambo" 'su 1° ruota
End If
ColoreTesto 2
If SerieFreq (ekk,ekk,ab,ruo2,2)>0 Then
Scrivi DataEstrazione (ekk)&" "& Left(NomeRuota (ruo2(1)),2)&" Ambo" 'su 2° ruota
End If
Next
ColoreTesto 1
Scrivi "--------------------------------------------------------------"
Scrivi "Ambo a tutte meno 20 estrazioni"''cerca ambo in cinquina a tutte

ColoreTesto 1
For k=1 To 20 'estrazioni antecedenti ultima estrazione
ek=es-k
ColoreTesto 1
If SerieFreq (ek,ek,ab,ruo3,2)>0 Then
Scrivi DataEstrazione (ek)&" "& Left(NomeRuota (ruo3(1)),2)&" Ambo" 'a tutte
End If
Next
ColoreTesto 1
Scrivi "---------------------------------------------------------------"

'***************************************************************

co=1
If ambt=1 Then
ImpostaGiocata co,am,ruote,post1,18,1
End If

For y=1 To 4
co=co+1
nm(2)=ab

ImpostaGiocata co,nm,ruote,post2,18,2
Next

ImpostaGiocata co+1,ab,ruote,post2,18,2

For y=2 To 6
For j=1 To 6
ImpostaInterruzioni j,1,1
ImpostaInterruzioni j,y,2
Next
Next

If ca=1 Or es>(fin-18) Then
Gioca es,,True
Else
Gioca es,True,True
End If

For z=1 To 6
If Esito(z)=False Then
ce=ce+1
End If
If ce=6 And es<(fin-18) Then
ci=ci+1
ColoreTesto 2
Scrivi String(49," ")&"ESITO NEGATIVO al "& DataEstrazione(es+18),1
ColoreTesto 0
Scrivi ""
End If
Next
ce=0
End If 'chiude if cu=1
Next 'chiude es
'-------------------------------
ColoreTesto 1
Scrivi String(90,"=")
ColoreTesto 2
Scrivi "Numeri data "& StringaNumeri

,1
Scrivi "Se due numeri della data formeranno un ambo su una ruota"&_
" e il terzo sarà presente su"& Chr(13)&"un'altra ruota qualsiasi,"&_
" si giocherà questa previsione sulle ruote di rilevamento:"

If ambt=1 Then
Scrivi am(1)&" Ambata",1
End If

Scrivi nm(1)&"-"&ab(1)&" Ambo"&Chr(13)&_
nm(1)&"-"&ab(2)&" Ambo"&Chr(13)&_
nm(1)&"-"&ab(3)&" Ambo"&Chr(13)&_
nm(1)&"-"&ab(4)&" Ambo"&Chr(13)&_
ab(1)&"."&ab(2)&"."&ab(3)&"."&ab(4)&"."&ab(5)&" Cinquina",1
ColoreTesto 1
Scrivi String(90,"=")
Scrivi
Scrivi " Eventi presentatisi: "&ca&Chr(13)&_
" Eventi positivi: "&ca-ci&Chr(13)&_
" Eventi negativi: "&ci,1

ScriviResoconto 1
ScriviResoconto 6
ScriviResoconto ,True

End Sub

solare · 13 Settembre 2014

Riporto su sperando che qualcuno riesca

Mike58 · 13 Settembre 2014

Ciao Solare, senza pretesa, ho solo modificato qualcosa per essere letto da spaziometria.
Per Tutto il resto, quello che sono le condizioni intrecciate non sono entrato nel merito.

Vedi se cosi fa quello che deve fare.

Codice:

Sub Main()
	Dim n(4),x(4),nu(6),am(1),ab(5),abb(8),aabb(8),nm(2),nr(4)
	Dim vet_ru(),ruote(2),ruo1(1),ruo2(1),ruo3(1),ruota(1),post1(1),post2(2)
	ruo3(1) = 11
	post1(1) = 1
	post2(2) = 1
	fin = EstrazioneFin
	'-------------------------------------
	ts1 = "DATA INIZIO VERIFICA ???" & Chr(13) & Chr(13) & _
	"scrivere la data in formato GG.MM.AAAA" & Chr(13) & _
	"separati dal *PUNTO*" & Chr(13) & Chr(13) & "Es: 01.01.2000"
	a1 = InputBox(ts1,,DataEstrazione(7300)) 'Inizio estrazione se scrivi 1= dal 1871
	a1 = "0." & a1
	nu1 = Split(a1,".")
	data1 = nu1(1) & "/" & nu1(2) & "/" & nu1(3)
	ini = PrimaSuccessiva(data1)
	Messaggio "dal " & data1
	'------------------------------------
	ac = "INSERIRE I TRE NUMERI DELLA DATA SPIA" & Chr(13) & Chr(13) & Chr(13) & _
	"""DISTANZA 18""" & Chr(13) & _
	"IN ORDINE DI DISTANZA (CIOE' 1) DISTANZA 18 (CIOE' 19) E DISTANZA 45 (CIOE' 46) QUINDI 1-19-46 ,,, 2-20-47 , Ect,Ect " & Chr(13) & Chr(13) & Chr(13) & _
	"""DISTANZA 27""" & Chr(13) & _
	"IN ORDINE DI DISTANZA (CIOE' 1) DISTANZA 27 (CIOE' 28) E DISTANZA 45 (CIOE' 46) QUINDI 1-28-46 ,,, 2-29-47, Ect,Ect" & Chr(13) & Chr(13) & _
	"SEPARATI dal *PUNTO**Es: 01.01.01.01"
	'----------------------------------------
	aa = InputBox(ac,"","1.11.31")
	aa = "0." & aa
	numeri = Split(aa,".")
	For j = 1 To UBound(numeri)
		n(j) = CInt(numeri(j))
	Next
	'-------------------------------------
	iruote = InputBox("Quali ruote vuoi analizzare?",,"1.2.3.4.5.6.7.8.9.10")
	iruote = "0." & iruote
	rrr = Split(iruote,".")
	qr =(UBound(rrr))
	ReDim vet_ru(qr)
	rigru = ""
	For j = 1 To qr
		vet_ru(j) = CInt(rrr(j))
		rigru = rigru & SiglaRuota(vet_ru(j)) & " "
	Next
	Scrivi "RICERCA EFFETTUATA SULLE RUOTE " & rigru,1
	'-------------------------------------
	ambt = InputBox("GIOCO L'AMBATA ???" & Chr(13) & Chr(13) & _
	"1 = SI" & Chr(13) & "0 = NO",,1)
	ambt = CInt(ambt)
	'-------------------------------------
	ci = 0
	ca = 0
	For es = ini To fin
		Messaggio es
		x(1) = n(1)
		x(2) = n(2)
		x(3) = n(3)
		am(1) = Fuori90(x(1) + x(2) + x(3))
		ab(1) = Fuori90(am(1) + 9)
		ab(2) = Fuori90(am(1) + 81)
		nm(1) = am(1)
		cu = 0
		Erase nr
		For ir = 1 To qr '<===== prima ruota
			r = vet_ru(ir)
			For p = 1 To 4
				a = Estratto(es,r,p)
				If a = x(1) Or a = x(2) Or a = x(3)Then
					For q = p + 1 To 5
						b = Estratto(es,r,q)
						If b = x(1) Or b = x(2) Or b = x(3) Then
							If a = x(1) Or b = x(1) Then x(1) = 0
							If a = x(2) Or b = x(2) Then x(2) = 0
							If a = x(3) Or b = x(3) Then x(3) = 0
							OrdinaMatrice x,- 1
							For ir1 = 1 To qr '<===== prima ruota
								r1 = vet_ru(ir1)
								If r1 <> r And Posizione(es,r1,x(1)) > 0 Then
									ruote(1) = r
									ruote(2) = r1
									ruo1(1) = r
									ruo2(1) = r1
									nr(1) = a
									nr(2) = b
									nr(3) = x(1)
									nr(4) = x(2)
									cu = cu + 1
								End If
							Next 'chiude ir1
						End If 'chiude If b=x(1) Or b=x(2) Or b=x(3)
					Next 'chiude for q
				End If ' chiude If a=x(1) Or a=x(2) Or a=x(3)
			Next 'chiude for p
		Next 'chiude ir
		If cu = 1 Then
			ca = ca + 1
			Scrivi "'************************************************ *************************************"
			Scrivi FormatSpace(ca,4) & DataEstrazione(es) & " " & _
			Left(NomeRuota(ruote(1)),2) & " " & Format2(nr(2)) & " " & Format2(nr(1)) & " " & _
			Left(NomeRuota(ruote(2)),2) & " " & Format2(nr(3)),1
			ColoreTesto 1
			Scrivi "------------------------------------------------"
			ColoreTesto 0
			Scrivi "15 Estrazioni" 'estrazioni antecedenti ultima estrazione
			For xx = 1 To 20
				ex = es - xx
				ColoreTesto 0
				If Posizione(ex,ruote(1),am(1)) > 0 Then
					Scrivi Left(NomeRuota(ruote(1)),2) & " " & Format2(am(1)) & _
					" già sortito il " & DataEstrazione(ex)
				End If
				ColoreTesto 2
				If Posizione(ex,ruote(2),am(1)) > 0 Then
					Scrivi Left(NomeRuota(ruote(2)),2) & " " & Format2(am(1)) & _
					" già sortito il " & DataEstrazione(ex)
				End If
			Next
			Scrivi "---------------------------------------------------------------"
			Scrivi "Ambo a ruota meno 50 estrazioni" ''cerca ambo in cinquina su ruote
			For kk = 1 To 50 'estrazioni antecedenti ultima estrazione
				ekk = es - kk
				ColoreTesto 0
				If SerieFreq(ekk,ekk,ab,ruo1,2) > 0 Then
					Scrivi DataEstrazione(ekk) & " " & Left(NomeRuota(ruo1(1)),2) & " Ambo" 'su 1° ruota
				End If
				ColoreTesto 2
				If SerieFreq(ekk,ekk,ab,ruo2,2) > 0 Then
					Scrivi DataEstrazione(ekk) & " " & Left(NomeRuota(ruo2(1)),2) & " Ambo" 'su 2° ruota
				End If
			Next
			ColoreTesto 1
			Scrivi "--------------------------------------------------------------"
			Scrivi "Ambo a tutte meno 20 estrazioni"''cerca ambo in cinquina a tutte
			ColoreTesto 1
			For k = 1 To 20 'estrazioni antecedenti ultima estrazione
				ek = es - k
				ColoreTesto 1
				If SerieFreq(ek,ek,ab,ruo3,2) > 0 Then
					Scrivi DataEstrazione(ek) & " " & Left(NomeRuota(ruo3(1)),2) & " Ambo" 'a tutte
				End If
			Next
			ColoreTesto 1
			Scrivi "---------------------------------------------------------------"
			'************************************************* **************
			co = 1
			If ambt = 1 Then
				ImpostaGiocata co,am,ruote,post1,18,1
			End If
			For y = 1 To 4
				co = co + 1
				nm(2) = ab(y)
				ImpostaGiocata co,nm,ruote,post2,18,2
			Next
			ImpostaGiocata co + 1,ab,ruote,post2,18,2
			For y = 2 To 6
				For j = 1 To 6
					ImpostaInterruzioni j,1,1
					ImpostaInterruzioni j,y,2
				Next
			Next
			If ca = 1 Or es >(fin - 18) Then
				Gioca es,,True
			Else
				Gioca es,True
			End If
			For z = 1 To 6
				If eval(z) = False Then
					ce = ce + 1
				End If
				If ce = 6 And es <(fin - 18) Then
					ci = ci + 1
					ColoreTesto 2
					Scrivi String(49," ") & "ESITO NEGATIVO al " & DataEstrazione(es + 18),1
					ColoreTesto 0
					Scrivi ""
				End If
			Next
			ce = 0
		End If 'chiude if cu=1
	Next 'chiude es
	'-------------------------------
	ColoreTesto 1
	Scrivi String(90,"=")
	ColoreTesto 2
	Scrivi "Numeri data " & StringaNumeri(n),1
	Scrivi "Se due numeri della data formeranno un ambo su una ruota" & _
	" e il terzo sarà presente su" & Chr(13) & "un'altra ruota qualsiasi," & _
	" si giocherà questa previsione sulle ruote di rilevamento:"
	If ambt = 1 Then
		Scrivi am(1) & " Ambata",1
	End If
	Scrivi nm(1) & "-" & ab(1) & " Ambo" & Chr(13) & _
	nm(1) & "-" & ab(2) & " Ambo" & Chr(13) & _
	nm(1) & "-" & ab(3) & " Ambo" & Chr(13) & _
	nm(1) & "-" & ab(4) & " Ambo" & Chr(13) & _
	ab(1) & "." & ab(2) & "." & ab(3) & "." & ab(4) & "." & ab(5) & " Cinquina",1
	ColoreTesto 1
	Scrivi String(90,"=")
	Scrivi
	Scrivi " Eventi presentatisi: " & ca & Chr(13) & _
	" Eventi positivi: " & ca - ci & Chr(13) & _
	" Eventi negativi: " & ci,1
	ScriviResoconto
End Sub

solare · 13 Settembre 2014

Grazie Mike58, gentilissimo come sempre

Cerca

Cerca

Richiesta Modifica listato x ricerca

solare

Advanced Member >PLATINUM<

solare

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

solare

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi