ambi distanza dispari e pari

gamberorosso · 10 Agosto 2013

ciao mi chiedevo se qualcuno fosse capace di fare questo script
Dovrei trovare in due estrazioni due ambi isotopi con la solita distanza.. nelle due estrazioni devo trovare un altro ambo con una distanza diversa ma sempre dispari se gli ambi trovati sono di distanza dispari oppure pari se gli ambi trovati sono pari
es:
roma 61.70.68.14.56
milano 71.80.02.77.05
61-70 ds 9
71-80 ds 9 -----02-77 dis 15 tutte e tre dispari le altre sono tutte pari
distanza 9 dispari ma nella solita estrazione e uscito anche un ambo sempre con distanza dispari 2-77 DS 15
ecco tutto qui.
roma distanze
distanza 61-70=9 dispari 'ambo trovato
distanza 68-70=2 pari
distanza 68-14=36 pari
distanza 14-56 =42 pari
milano distanze
distanza 71-80=9 dispari ambo trovato
distanza 80-02= 12 pari
distanza 02-77=15 dispari 'ambo con distanza diversa ma sempre dispari
distanza 77-05=18 pari
grazie

gamberorosso · 11 Agosto 2013

Questo trovato in giro e di rosanna su lottodesk.

Sub main()

Dim Ambi_o(),Ambi_vd()

tipo=(InputBox("Cosa vuoi cercare ? " &Vblf&_
Vblf& "Distanza ciclometrica = 1" &Vblf&_
Vblf& "Differenza aritmetica = 2" &Vblf&_
Vblf& "Somme = 3" ,,1))

If tipo="" Or tipo >3 Then
MsgBox("Hai inserito un valore non valido")
Exit Sub
End If

x= InputBox("Di quale valore (distanza, differenza o somma) vuoi cercare gli ambi?",,45)
'------------------------------------------VERIFICHE INPUTBOX
If tipo=1 And x<1 Or tipo=1 And x >45 Then
MsgBox("Per le distanze ciclometriche inserire un valore tra 1 e 45")
Exit Sub
End If

If tipo= 2 And x <1 Or tipo= 2 And x >89 Then
MsgBox("Per le differenze inserire un valore tra 1 e 89")
Exit Sub
End If

If tipo= 3 And x <1 Or tipo= 3 And x >90 Then
MsgBox("Per le somme inserire un valore tra 1 e 90")
Exit Sub
End If
'-------------------------------------------- ANALISI E RICERCA AMBI ORIZZONTALI
es=EstrazioneFin
x=CInt(x)

Cao=0 'Contatore ambi orizzontali
Redim Ambi_o(5,0) 'dimensiono la matrice ambi orizzontali
For r= 1 To 12
If r<> 11 Then
For p1=1 To 4
For p2=p1+1 To 5
ok=0

Select Case tipo
Case 1 : If Distanza(Estratto(es,r,p1),Estratto(es,r,p2)) = x Then ok=1
Case 2 : If Abs(Estratto(es,r,p1)-Estratto(es,r,p2))= x Then ok=1
Case 3 : If Fuori90(Estratto(es,r,p1)+Estratto(es,r,p2))= x Then ok=1
End Select

If ok=1 Then
CAo= cAo+1
Redim preserve Ambi_o(5,cao)
Ambi_o(1,cao)=r 'la 1^ riga contiene la ruota
Ambi_o(2,cao)=Estratto(es,r,p1)'la 3^ riga contiene il 1°num
Ambi_o(3,cao)=Estratto(es,r,p2)'la 5^ riga contiene il 2°num
Ambi_o(4,cao)=p1'la 2^ riga contiene la posizione del 1° num
Ambi_o(5,cao)=p2'la 4^ riga contiene la posizione del 2° num
End If
Next
Next
End If
Next
'--------------------------------------------------ANALISI E RICERCA AMBI VERTICALI DIAGONALI

Cavd=0 'Contatore ambi verticali e diagonali

Redim Ambi_vd(6,0) 'dimensiono la matrice ambi verticali e diagonali
For r1= 1 To 10
For p1=1 To 5
For r2=r1+1 To 12
If r2<> 11 Then
For q1= 1 To 5

okk=0
Select Case tipo

Case 1 :If Distanza(Estratto(es,r1,p1),Estratto(es,r2,q1)) = x Then okk=1
Case 2 : If Abs(Estratto(es,r1,p1)-Estratto(es,r2,q1))= x Then okk=1
Case 3 : If Fuori90(Estratto(es,r1,p1)+Estratto(es,r2,q1))= x Then okk=1
End Select

If okk=1 Then
CAvd= cAvd+1 'incremento contatore ambi verticali e diagonali
Redim preserve Ambi_vd(6,cavd)
Ambi_vd(1,cavd)=r1 'la 1^ riga contiene la 1^ruota
Ambi_vd(2,cavd)=Estratto(es,r1,p1)'la 3^ riga contiene il 1°num (1^ruota)
Ambi_vd(3,cavd)=r2 'la 4^ riga contiene la 2^ruota
Ambi_vd(4,cavd)=Estratto(es,r2,q1)'la 6^ riga contiene il 2°num (2^ruota)
Ambi_vd(5,cavd)=p1'la 2^ riga contiene la posizione del 1° num (1^ruota)
Ambi_vd(6,cavd)=q1'la 5^ riga contiene la posizione del 2° num (2^ruota)
End If
Next
End If
Next
Next
Next
'--------------------------------------------------------------- OUTPUT DEI RISULTATI
Scrivi
Scrivi Space(20)&" ESTRAZIONE DEL "& DataEstrazione(es)& " - AMBI CON: ",1
Scrivi Space(20)&" ",1,0
If TIPO=1 Then ColoreTesto 1:Scrivi " DISTANZA CICLOMETRICA ==> ",1,0: ColoreTesto 2:scrivi X&CHR(10),1
If TIPO=2 Then ColoreTesto 1:Scrivi " DIFFERENZA ARITMETICA ==> ",1,0: ColoreTesto 2:scrivi X&CHR(10),1
If TIPO=3 Then ColoreTesto 1:Scrivi " SOMMA ==> ",1,0: ColoreTesto 2:scrivi X&CHR(10),1
ColoreTesto 0
Scrivi String(78,"*")&chr(10)
If cao> 0 Then
Scrivi " Orizzontali (su ruota unica) ["& cao&"]",1
For i= 1 To cao
Scrivi Space(33)& SiglaRuota(Ambi_o(1,i)) & " "& Format2(Ambi_o(2,i))& " - "& Format2(Ambi_o(3,i)) &_
" ("&(Ambi_o(4,i))&"-"& (Ambi_o(5,i))&")"
Next
Else
Scrivi " Nessun ambo orizzontale (su ruota) corrisponde alla ricerca impostata "
End If
Scrivi
iso=0

If cavd>0 Then
For i= 1 To cavd
If (Ambi_vd(5,i) = Ambi_vd(6,i)) Then iso=iso+1
Next

If iso>1 Then
Scrivi " Verticali (su due ruote - isotopo) ["& iso&"]",1
For i= 1 To cavd
If (Ambi_vd(5,i)) = (Ambi_vd(6,i)) Then
Scrivi Space(39)& SiglaRuota(Ambi_vd(1,i)) & " "& Format2(Ambi_vd(2,i))& " - "& SiglaRuota(Ambi_vd(3,i)) &_
" "&Format2(Ambi_vd(4,i))& " ("&(Ambi_vd(5,i))&"-"& (Ambi_vd(6,i))&")"
End If
Next
Else
Scrivi " Nessun ambo verticale (su due ruote - isotopo) corrisponde alla ricerca impostata "&chr(10)
End If

If cavd-iso > 0 Then
Scrivi
Scrivi " Diagonali (su due ruote - non isotopo) ["& cavd-iso&"]",1
For i= 1 To cavd
If (Ambi_vd(5,i)) <> (Ambi_vd(6,i)) Then
Scrivi Space(45)& SiglaRuota(Ambi_vd(1,i)) & " "& Format2(Ambi_vd(2,i))& " - "& SiglaRuota(Ambi_vd(3,i)) &_
" "&Format2(Ambi_vd(4,i))& " ("&(Ambi_vd(5,i))&"-"& (Ambi_vd(6,i))&")"
End If
Next
End If
Else
Scrivi " Nessun ambo verticale e diagonale (su due ruote - isotopo e non) corrisponde alla ricerca impostata "
End If

Rosanna · 12 Agosto 2013

Il listato che hai preso non è completo e ahimè incollato così è privo di indentazione.... (soffro...)

Non ho capito se cmq fa quello che desideri o no. A tutti i miei listati ho messo e metto un numero di riferimento per poterlo rintracciare sul mio pc ma non lo vedo.
Magari non è mio ma fa nulla...

Prima di andare da Morfeo ti chiedo... lumi.
Scrivi

Dovrei trovare in due estrazioni due ambi isotopi con la solita distanza.. nelle due estrazioni devo trovare un altro ambo con una distanza diversa ma sempre dispari se gli ambi trovati sono di distanza dispari oppure pari se gli ambi trovati sono pari

"nelle due estrazioni"... intendi stessa estrazione ma due ruote diverse? (dall'esempio sembra così ma mancano le date per cui non sono certa)
Hai calcolato le distanze tra 1°-2°, 2°-3°, 3°-4°,4°-5° e.... tra il 5° e il 1° non serve controllare?
con "solita distanza" intendi dire .. "stessa distanza"?

ciao

gamberorosso · 12 Agosto 2013

"nelle due estrazioni"... intendi stessa estrazione ma due ruote diverse? SI
Hai calcolato le distanze tra 1°-2°, 2°-3°, 3°-4°,4°-5° e.... tra il 5° e il 1° non serve controllare? SI
con "solita distanza" intendi dire .. "stessa distanza"? SI

Ciao e grazie le distanze vanno calcolate tra 1°-2°, 2°-3°, 3°-4°,4°-5° queste sole.......ci devono essere due ambi con solita distanza non importa quale sia se 10 oppure 15 ....
ti metto un esempio:
sabato 28 ottobre
ruote firenze genova
firenze es 79-82-74-77-02
genova es 39-54-46-76-32
firenze----distanza 1-2=3 2-3=8 3-4=3 4-5=15
genova---distanza 1-2=15 2-3=8 3-4=30 4-5=44
-------------------------------------------------------------
Le distanze isotope sono 2-3 distanza 8 sia su genova che firenze e sono pari
le altre distanze sono dispari meno che la distanza tra il 4-5 che è pari.... ecco che ci sono due distanze uguali pari + una distanza pari ma non uguale sempre nella solita estrazione.
Grazie
PS: il listato e il tuo ma non fa quello che chiedo.... lo messo solo se qualcuno lo poteva modificare ti metto il link:
hxxp://www.lottodesk.it/forum/index.php?topic=454.0 togli le xx non so se si può mettere grazie di nuovo

Rosanna · 15 Agosto 2013

Ciao
l'ultimo esempio fatto su genova oltre alla distanza 4.5 che è pari c'è anche la 3.4 quindi se ho capito quel caso non è valido.

Ecco il mio listato
Per il range delle estrazioni usa la barra del programma.
Se rilevi errori gentilmente segnala nel dettaglio cosa non va citando un caso.
ciao

Codice:

Option Explicit
Sub Main
' 0904_17 Rosanna x Gamberorosso.ls
'http://forum.lottoced.com/f12/ambi-Distanza-dispari-e-pari-106451/

Dim es,r1,r2,p,i,y,z,d,a1,a2
Dim sRigPar1,sRigPAr2,sRigDis1,sRigDis2,nCon
Dim mDatiEs(2,12,4),aTotEs(12),aDist(3)

Call Scrivi("RICERCA 2 AMBI ISOTOPI CON DISTANZA UGUALE")
Call Scrivi("NB: se la dist uguale è pari le altre della stessa ruota devono essere dispari ")
Call Scrivi("e sull'altra ruota deve esserci un altro ambo con distanza pari -  e viceversa")
Call Scrivi

For es = EstrazioneIni To EstrazioneFin
	AvanzamentoElab EstrazioneIni,EstrazioneFin,es

	For i = 1 To 2 'inizializzo la matrice mDatiEs
		For y = 1 To 12
			aTotEs(y) = 0
			For z = 1 To 4
				mDatiEs(i,y,z) = - 1
			Next
		Next
	Next

	For r1 = 1 To 11
		If r1 = 11 Then r1 = 12
			For p = 1 To 4
				a1 = Estratto(es,r1,p)
				a2 = Estratto(es,r1,p + 1)
				d = Distanza(a1,a2)
				mDatiEs(1,r1,p) = d	
				If pari(d)Then mDatiEs(2,r1,p) = 0 Else mDatiEs(2,r1,p) = 1
				aTotEs(r1) = aTotEs(r1) + mDatiEs(2,r1,p)
			Next
			
	Next
	
	For r1 = 1 To 10
		If r1 = 11 Then r1 = 11
		For r2 = r1 + 1 To 11
			If r2 = 11 Then r2 = 12
			For p = 1 To 4
				If mDatiEs(1,r1,p) = mDatiEs(1,r2,p)Then
					If mDatiEs(2,r1,p) = 0 Then ' se la distanza uguale è pari						
						If aTotEs(r1) = 3 And aTotEs(r2) = 2 Or aTotEs(r1) = 2 And aTotEs(r2) = 3 Then 'vedo i casi in cui R1 abbia 2 pari e R2 3 dispari o viceversa
							Call ColoreTesto(1)
							sRigPar1 = DataEstrazione(es) & " " & SiglaRuota(r1) & " "
							sRigPAr2 = DataEstrazione(es) & " " & SiglaRuota(r2) & " " 'inizializzo le stringhe	
							nCon = 0 'inizializzo il contatore
							For i = 1 To 3
								aDist(i) = 0
							Next						
							For i = 1 To 4
								If mDatiEs(2,r1,i) = 0 Then '0=distanza pari sulla r1
									nCon = nCon + 1
									aDist(nCon) = mDatiEs(1,r1,i)
									sRigPar1 = sRigPar1 & " dist (" & i & "." & i + 1 & " = " & mDatiEs(1,r1,i) & ") " & Estratto(es,r1,i) & "." & Estratto(es,r1,i + 1)
								End If
								If mDatiEs(2,r2,i) = 0 Then '0=distanza pari sulla r2
									nCon = nCon + 1
									aDist(nCon) = mDatiEs(1,r2,i)
									sRigPAr2 = sRigPAr2 & " dist (" & i & "." & i + 1 & " = " & mDatiEs(1,r2,i) & ") " & Estratto(es,r2,i) & "." & Estratto(es,r2,i + 1)
								End If
							Next	
							If aDist(1) <> aDist(2) Or aDist(1) <> aDist(3) Or aDist(2) <> aDist(3) Then 'per escludere i casi in cui le 3 dist sono tutte uguali
								Call Scrivi(sRigPar1)
								Call Scrivi(sRigPAr2)
								Call Scrivi
								Call ColoreTesto(0)
							End If
						End If
					Else 'altrimenti se la distanza uguale è dispari
						If aTotEs(r1) = 1 And aTotEs(r2) = 2 Or aTotEs(r1) = 2 And aTotEs(r2) = 1 Then ' vedo i casi in cui R1 abbia 2 dispari e R2 3 pari o viceversa
							Call ColoreTesto(1)
							sRigDis1 = DataEstrazione(es) & " " & SiglaRuota(r1) & " "
							sRigDis2 = DataEstrazione(es) & " " & SiglaRuota(r2) & " " 'inizializzo le stringhe	
							nCon = 0 'inizializzo il contatore
							For i = 1 To 3
								aDist(i) = 0
							Next						
							For i = 1 To 4
								If mDatiEs(2,r1,i) = 1 Then '1=distanza dispari sulla r1
									nCon = nCon + 1
									aDist(nCon) = mDatiEs(1,r1,i)
									sRigDis1 = sRigDis1 & " dist (" & i & "." & i + 1 & " = " & mDatiEs(1,r1,i) & ") " & Estratto(es,r1,i) & "." & Estratto(es,r1,i + 1)
								End If
								If mDatiEs(2,r2,i) = 1 Then
									nCon = nCon + 1
									aDist(nCon) = mDatiEs(1,r2,i)
									sRigDis2 = sRigDis2 & " dist (" & i & "." & i + 1 & " = " & mDatiEs(1,r2,i) & ") " & Estratto(es,r2,i) & "." & Estratto(es,r2,i + 1)
								End If
							Next	
							If aDist(1) <> aDist(2) Or aDist(1) <> aDist(3) Or aDist(2) <> aDist(3) Then 'per escludere i casi in cui le 3 dist sono tutte uguali
							
								Call Scrivi(sRigDis1)
								Call Scrivi(sRigDis2)
								Call Scrivi
								Call ColoreTesto(0)
							End If
						End If
					End If
				End If
			Next
		Next
	Next			
Next			
End Sub

ps per il listato su lottodesk hai ragione è mio. Si vede che a quel tempo non li catalogavo ancora..

gamberorosso · 15 Agosto 2013

grazie Rosanna e buon ferragosto adesso lo provo...... gentilissima

gamberorosso · 15 Agosto 2013

Perfetto grazie

Rosanna · 15 Agosto 2013

Bene. Buon ferragosto anche a te. ciao

Cerca

Cerca

ambi distanza dispari e pari

gamberorosso

Senior Member

gamberorosso

Senior Member

Rosanna

Super Member >PLATINUM<

gamberorosso

Senior Member

Rosanna

Super Member >PLATINUM<

gamberorosso

Senior Member

gamberorosso

Senior Member

Rosanna

Super Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi