Ciao luigi....se posso

[mastrogino]

ciao nn ti vorrei disturbare
ma se trovi un buco di tempo mi potresti fare questo script con questi parametri ...


lo script deve trovare l'ambo di somma 91 sull'albo estrazionale e le ruote in cui vi sono i numeri in comune
esempio
bari 87.04..........roma.87...........to ...04.
se nn vi siano segnala solo l'ambo .....
anche nell'ultima estrazione

grazie infinite

 

[LuigiB]

trattandosi di una banalità di 5 minuti l'ho fatto .. ciao

Option Explicit
Sub Main
	Dim idEstr,Ruota,r
	Dim Inizio,Fine
	Dim k,kk,i,n1,n2,nn
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	For idEstr = Inizio To Fine
		For Ruota = 1 To 12
			If Ruota <> 11 Then
				For k = 1 To 4
					For kk = k + 1 To 5
						n1 = Estratto(idEstr,Ruota,k)
						n2 = Estratto(idEstr,Ruota,kk)
						If n1 + n2 = 91 Then
							Call Scrivi(GetInfoEstrazione(idEstr))
							Call Scrivi(SiglaRuota(Ruota) & " " & Format2(n1) & "." & Format2(n2))
							For r = 1 To 12
								If r <> 11 And r <> Ruota Then
									For i = 1 To 5
										nn = Estratto(idEstr,r,i)
										If nn = n1 Or nn = n2 Then
											Call Scrivi(SiglaRuota(r) & " " & StringaEstratti(idEstr,r))
										End If
									Next
								End If
							Next
							Call Scrivi (String(100 , "_"))
						End If
					Next
				Next
			End If
		Next
		Call AvanzamentoElab(Inizio,Fine,idEstr)
		If ScriptInterrotto Then Exit For
	Next
End Sub

 

[mastrogino]

grazie 1000 Luigi ....lo so e una cavolata ....saperlo fare
so anche che l atua bravura e al di sopra
questo lavoro e una banalita ma credimi ......e lo dico serio
e un grande lavoro di anni . e meglio che mi fermo qui
ciao oooo

ps una grande stima da parte mia

 

[LuigiB]

ciao Schiro grazie ...

 

[stefania1972]

Ciao LuigiB e schiro' gioacchino chiedo scusa se mi intrometto nel vostro post , volevo chiedere al sig. LuigiB se per favore sarebbe cosi' gentile di apportare una modifica allo script di sopra , a me servirebbe che lo script trovi la somma 91 su due ruote sia in posizione isotopa che non isatopa e sia in orizzontale che in verticale che in diagonale .
Spero di non chiedere troppo e che sia possibile , ringrazio anticipatamente LuigiB o chiunque abbia il tempo di fare una correzzione allo script , grazie , ciao .

 

[LuigiB]

le modifiche che hai chiesto ineffetti rendono il tutto un attimino piu complicato
Eccol lo script , ciao

Option Explicit
Sub Main
	Dim idEstr
	Dim Inizio,Fine
	Dim nSomma
	nSomma = 91
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	ReDim aScelta(6)
	If SceltaTipoRilevamento(aScelta) Then
		For idEstr = Inizio To Fine
			ReDim aEstr(11,5)
			If GetEstrazioneCompleta(idEstr,aEstr) Then
				If aScelta(0) Then Call CercaSuRuotaSingola(idEstr,aEstr,nSomma)
				If aScelta(1) Then Call CercaSuDueRuoteIsotopo(idEstr,aEstr,nSomma,True)
				If aScelta(2) Then Call CercaSuDueRuoteIsotopo(idEstr,aEstr,nSomma,False)
				If aScelta(3) Then Call CercaSuDueRuoteNonIsotopo(idEstr,aEstr,nSomma,True)
				If aScelta(4) Then Call CercaSuDueRuoteNonIsotopo(idEstr,aEstr,nSomma,False)
				If aScelta(5) Then Call CercaSuDueRuoteDiagonale(idEstr,aEstr,nSomma,True)
				If aScelta(6) Then Call CercaSuDueRuoteDiagonale(idEstr,aEstr,nSomma,False)
			End If
			Call AvanzamentoElab(Inizio,Fine,idEstr)
			If ScriptInterrotto Then Exit For
		Next
	End If
End Sub
Function SceltaTipoRilevamento(avSel)
	ReDim aV(6)
	aV(0) = "Ruota singola"
	aV(1) = "Due ruote consecutive isotopo"
	aV(2) = "Due ruote qualsiasi isotopo"
	aV(3) = "Due ruote consecutive non isotopo"
	aV(4) = "Due ruote qualsiasi non isotopo"
	aV(5) = "Due ruote consecutive diagonale"
	aV(6) = "Due ruote qualsiasi diagonale"
	SceltaTipoRilevamento = ScegliDaLista(aV,avSel)
End Function
Sub EvidenziaNumeriSuAltreRuote(idEstr,n1,n2,RuotaA,RuotaB,aEstr)
	Dim r,k,y,sTrov,rt,b
	Dim sRuote
	b = False
	Call Scrivi(GetInfoEstrazione(idEstr))
	Call Scrivi(Format2(n1) & "." & Format2(n2),True)
	sRuote = SiglaRuota(Iif(RuotaA = 11,12,RuotaA)) & " " & StringaEstratti(idEstr,Iif(RuotaA = 11,12,RuotaA))
	Call Scrivi(sRuote)
	If RuotaB <> 0 Then
		sRuote = SiglaRuota(Iif(RuotaB = 11,12,RuotaB)) & " " & StringaEstratti(idEstr,Iif(RuotaB = 11,12,RuotaB))
		Call Scrivi(sRuote)
	End If
	Call Scrivi
	Call Scrivi("Numeri rilevati su altre ruote",True)
	For r = 1 To 11
		If r <> RuotaA And r <> RuotaB Then
			rt = Iif(r = 11,12,r)
			sTrov = ""
			For k = 1 To 5
				If aEstr(r,k) = n1 Or aEstr(r,k) = n2 Then
					'sTrov =   StringaEstratti( idEstr ,rt)
					For y = 1 To 5
						If aEstr(r,y) = n1 Or aEstr(r,y) = n2 Then
							sTrov = sTrov & "<b><font color = Red >" & Format2(aEstr(r,y)) & "</font></b>" & "."
						Else
							sTrov = sTrov & "<font color = Black >" & Format2(aEstr(r,y)) & "</font>" & "."
						End If
					Next
					If sTrov <> "" Then
						b = True
						sTrov = Left(sTrov,Len(sTrov) - 1)
						sTrov = SiglaRuota(rt) & " " & sTrov
						Call Scrivi(sTrov)
						Exit For
					End If
				End If
			Next
		End If
	Next
	If b = False Then
		Call Scrivi("Nessuno")
	End If
	Call Scrivi(String(100,"-"))
End Sub
Sub CercaSuRuotaSingola(idEstr,aEstr,s)
	Dim k,kk
	Dim Ruota
	For Ruota = 1 To 11
		For k = 1 To 4
			For kk = k + 1 To 5
				If aEstr(Ruota,k) + aEstr(Ruota,kk) = s Then
					Call Scrivi("Ruota singola",True)
					Call EvidenziaNumeriSuAltreRuote(idEstr,aEstr(Ruota,k),aEstr(Ruota,kk),Ruota,0,aEstr)
				End If
			Next
		Next
	Next
End Sub
Sub CercaSuDueRuoteIsotopo(idEstr,aEstr,s,bConsec)
	Dim k
	Dim RuotaA,RuotaB
	Dim b
	For RuotaA = 1 To 10
		For RuotaB = RuotaA + 1 To 11
			b = False
			If bConsec Then
				If RuotaB - 1 = RuotaA Then
					b = True
				End If
			Else
				b = True
			End If
			If b Then
				For k = 1 To 5
					If aEstr(RuotaA,k) + aEstr(RuotaB,k) = s Then
						Call Scrivi("Due ruote " & Iif(bConsec,"consecutive","qualsiasi") & " isotopo",True)
						Call EvidenziaNumeriSuAltreRuote(idEstr,aEstr(RuotaA,k),aEstr(RuotaB,k),RuotaA,RuotaB,aEstr)
					End If
				Next
			End If
		Next
	Next
End Sub
Sub CercaSuDueRuoteNonIsotopo(idEstr,aEstr,s,bConsec)
	Dim k,kk
	Dim RuotaA,RuotaB
	Dim b
	For RuotaA = 1 To 10
		For RuotaB = RuotaA + 1 To 11
			b = False
			If bConsec Then
				If RuotaB - 1 = RuotaA Then
					b = True
				End If
			Else
				b = True
			End If
			If b Then
				For k = 1 To 5
					For kk = 1 To 5
						If kk <> k Then
							If aEstr(RuotaA,k) + aEstr(RuotaB,kk) = s Then
								Call Scrivi("Due ruote " & Iif(bConsec,"consecutive","qualsiasi") & " non isotopo",True)
								Call EvidenziaNumeriSuAltreRuote(idEstr,aEstr(RuotaA,k),aEstr(RuotaB,kk),RuotaA,RuotaB,aEstr)
							End If
						End If
					Next
				Next
			End If
		Next
	Next
End Sub
Sub CercaSuDueRuoteDiagonale(idEstr,aEstr,s,bConsec)
	Dim k,kk
	Dim RuotaA,RuotaB
	Dim b
	For RuotaA = 1 To 10
		For RuotaB = RuotaA + 1 To 11
			b = False
			If bConsec Then
				If RuotaB - 1 = RuotaA Then
					b = True
				End If
			Else
				b = True
			End If
			If b Then
				For k = 1 To 5
					For kk = 1 To 5
						If Abs(k - kk) = 1 Then
							If aEstr(RuotaA,k) + aEstr(RuotaB,kk) = s Then
								Call Scrivi("Due ruote " & Iif(bConsec,"consecutive","qualsiasi") & " diagonale",True)
								Call EvidenziaNumeriSuAltreRuote(idEstr,aEstr(RuotaA,k),aEstr(RuotaB,kk),RuotaA,RuotaB,aEstr)
							End If
						End If
					Next
				Next
			End If
		Next
	Next
End Sub

 

[stefania1972]

Ciao LuigiB innanzitutto grazie per il tempo che mi ha dedicato lo sript e' perfetto , ma io sicuramente mi sono spiegata male io per somma 91 su due ruote intendevo in questo modo :
Esempio : Bari = 1 - 2 - 3 - 4 - 87
Cagliari = 6 - 7 - 8 - 9 - 82
Dove su Bari ( 4 + 87 ) = somma 91
E su Cagliari ( 9 + 82 ) = somma 91
La somma 91 su due ruote sia in posizione isotopa che non isatopa e sia in orizzontale che in verticale che in diagonale .
Mi deve scusare se non mi sono spiegata bene , spero che con questo esempio sia piu chiaro e che si possa fare , la ringrazio infinitamente , ciao .

 

[LuigiB]

purtroppo questa ultima modifica cambia radicalmente lo script. Mi dispiace.Ciao

 

[stefania1972]

Ciao sig.LuigiB la ringrazio ugualmente , ciao .