x cortesia mi fate 1 script?

[rob.]

Cortesemente avrei bisogno di uno script che riesca a localizzare e segnalare nell'archivio (in tutte e 10 le ruote) tutte le situazioni come questa:


esempio----> BARI=21-27-46-68-03---->i vertibili uniti non vanno bene (tipo 48-84----24-42 ecc ecc

quindi:due numeri uniti (dove tutte e 4 le cifre siano di segno pari) e che al centro sia presente un numero Gemello

detto in termini piu' semplici: due numeri uniti la cui cadenza del primo numero debba essere uguale alla decina del secondo numero;ovviamente tutti pari (vedi esempio)

un grazie anticipato a chi lo realizzera'

ciao rob

 

[Mike58]

Ciao Rob, ho letto che hai avuto problemi con spaziometria, se nella fattispecie hai risolto, eccoti una bozza di script che potrebbe fare quello che cerchi.
Se ci sono casi da escludere ulteriori, vedrò di ri-correggere.

Ciao

Sub Main()
	Dim a(1),b(1),ruota(1)
	qt = InputBox("QUANTE ESTRAZIONI CONTROLLO",,100)
	ini = EstrazioneFin - qt
	fin = EstrazioneFin
	ca = fin - Ini
	Scrivi String(120,"="),1
	Scrivi" Ricerca By Rob * Ambo consecutivo * Numeri Pari * ",1,0,3
	Scrivi"   su totali " & ca & " estrazioni  ",1,0,2
	Scrivi "  " & Chr(174) & "  Scripted by Mike58  " & Chr(169) & "  ",1,- 1,6
	Scrivi String(120,"="),1

	Scrivi
	Scrivi "Sono esclusi dalla ricerca i vertibili uniti,le decine zerate,e i numeri Gemelli ",1
	Scrivi
	ReDim AT(6)
	AT(1) = " Casi "
	AT(2) = " Data "
	AT(3) = " Ruota "
	AT(4) = " Estratti "
	AT(5) = " Ambo Trovato "
	AT(6) = " Posiz. "
	Call InitTabella(AT,1,,3,5)
	For es = fin To Ini Step - 1
		For r1 = 1 To 12
			If r1 = 11 Then r1 = 12
			ruota(1) = r1
			For p1 = 1 To 4
				p2 = p1 + 1
				'For p2 = p1 + 1 To 5
				a(1) = Estratto(es,r1,p1)
				b(1) = Estratto(es,r1,p2)
				d = Decina(a(1))
				If Cadenza(a(1)) = Decina(b(1)) Then
					If NumeriPari(b) = 2 Then
						If NumeriPari(a) = 2 Then
							If Gemello(a(1)) = False Then
							If Gemello(b(1)) = False Then
								If Decina(a(1)) > 1 And Cadenza(a(1)) > 1 Then
								If Decina(b(1)) > 1 And Cadenza(b(1)) > 1 Then
								If pari(d) Then
								
									casi = casi + 1
									ReDim AV(6)
									AV(1) = casi
									AV(2) = DataEstrazione(es)
									AV(3) = SiglaRuota(r1)
									AV(4) = StringaEstratti(es,r1)
									AV(5) = a(1) & " - " & b(1)
									AV(6) = p1 & " - " & p2
									Call AddRigaTabella(AV,,,3)
								End If
							End If
						End If
					End If
				End If
				End If
				End If
				End If
			Next
		Next
	Next
	'Call SetTableWidth("100%")
	Call CreaTabella()
End Sub

 

[carmelina]

se lo zero è considerato un numero pari, l'estrazione del 5 giugno a bari ha dato 20-48 nella stessa estrazione roma 68-88 88-42spero di esserti stata utile. ciao

 

[Mike58]

Ciao Carmelina, Si ho voluto eliminare, la decina Zerata ed i gemelli, e come ho detto è ancora una Bozza, aspettando Rob per ulteriori dettagli, lo invito anche a farmi esempi reali con ID e data estrazioni reali per maggiori riferimenti.
Infatti non trovo nell'archivio reale i numeri citati ad esempio su bari.
Può anche essere che l'immissione di una condizione escluda un altra.

Ci aggiorniamo.

 

[rob.]

Grazie Mike,hai fatto uno script fantastico,c'e'solo da "rivedere" un paio di cose,cioe' nel report dovresti eliminare gli ambi "Vertibili" tipo 26-62---24-42---86-68 ecc ecc perche' non sono validi per la ricerca che sto' facendo!!-L'ultima cosa dovresti escludere la ruota Nazionale dalla ricerca,per il resto va benissimo!!-ti ringrazio

NOTA: perche' il report da come ultimo caso utile in data 09.04.2011 quando invece ci sono altri casi validi oltre quella data??-devo impostare quacosa sullo script??---non ne sarei capace

 

[Mike58]

Ciao Rob, ho escluso i numeri Vertibili come richiesto e abilitato i numeri gemelli ( che erano disabilitati ), ho escluso anche la Nazionale.
Ho anche allineato il calcolo con lo script dell'amico Black, fatto dall'altra parte.
I calcoli anche se con algoritmi diversi sono allineati.

Vedi Tu se ci sono tutti i casi.

Sub Main()
	Dim a(1),b(1),ruota(1)
	qt = InputBox("QUANTE ESTRAZIONI CONTROLLO",,50)
	ini = EstrazioneFin - qt
	fin = EstrazioneFin
	ca = fin - Ini
	Scrivi String(120,"="),1
	Scrivi" Ricerca By Rob * Ambo consecutivo * Numeri Pari * ",1,0,3
	Scrivi"   su totali " & ca & " estrazioni  ",1,0,2
	Scrivi "  " & Chr(174) & "  Scripted by Mike58  " & Chr(169) & "  ",1,- 1,6
	Scrivi String(120,"="),1

	Scrivi
	Scrivi "Sono esclusi dalla ricerca i vertibili uniti,le decine & cadenzezerate,e i numeri Vertibili ",1
	Scrivi
	ReDim AT(7)
	AT(1) = " Casi "
	AT(2) = " Data "
	AT(3) = " Ruota "
	AT(4) = " Estratti "
	AT(5) = " Ambo Trovato "
	AT(6) = " Posiz. "
	AT(7) = " Num.Centrale "
	Call InitTabella(AT,1,,3,5)
	For es = Ini To fin
		For r1 = 1 To 10
			'If r1 = 11 Then r1 = 12
			ruota(1) = r1
			For p1 = 1 To 4
				p2 = p1 + 1
				'For p2 = p1 + 1 To 5
				a(1) = Estratto(es,r1,p1)
				b(1) = Estratto(es,r1,p2)
				d = Decina(a(1))
				If Cadenza(a(1)) = Decina(b(1)) Then
					If NumeriPari(b) = 2 Then
						If NumeriPari(a) = 2 Then
							'If Gemello(a(1)) = False Then
							If b(1) =  Vert(a(1)) = False Then
								If Decina(a(1)) > 0 And Cadenza(a(1)) > 0 Then
								If Decina(b(1)) > 0 And Cadenza(b(1)) > 0 Then
								If pari(d) Then
								
									casi = casi + 1
									ReDim AV(7)
									AV(1) = casi
									AV(2) = DataEstrazione(es)
									AV(3) = SiglaRuota(r1)
									AV(4) = StringaEstratti(es,r1)
									AV(5) = a(1) & " - " & b(1)
									AV(6) = p1 & " - " & p2
									AV(7) = Cadenza(a(1)) & Decina(b(1))
									Call AddRigaTabella(AV,,,3)
								End If
							'End If
						End If
					End If
				End If
				End If
				End If
				End If
			Next
		Next
	Next
	'Call SetTableWidth("100%")
	Call CreaTabella()
End Sub

script di Black.....

Sub Main()
Dim ruote(1)
ini = InputBox("QUANTE ESTRAZIONI VUOI ESAMINARE ?",,50)
fin = EstrazioneFin
For es = fin - ini To EstrazioneFin 
For r = 1 To 10
'If r = 11 Then r = 12
For p1 = 1 To 4
p2 = p1+1
n1 = Estratto(es,r,p1)
n2 = Estratto(es,r,p2)
If n2 = Vert(n1)= False Then
If pari(Decina(n1)) And pari(Decina(n2)) And pari(Cadenza(n1)) And pari(Cadenza(n2)) Then 
If Cadenza(n1) And Cadenza(n2) > 1 Then 
If Decina(n1) And Decina(n2) > 0 Then 
cad = Cadenza(n1)
dec = Decina(n2)
If cad = dec Then
If pari(cad) And pari(dec) Then
caddec =(cad & dec)
k = k + 1
Scrivi String(50,"=") & k,1
Scrivi DataEstrazione(es)&"  "& SiglaRuota(r)&"  "& StringaEstratti(es,r)&"   "& Format2(n1)&"  ["& caddec &"]  "& Format2(n2)
End If
End If
End If
End If
End If 
End If 
Next
Next
Next
End Sub