PER MIKE58

trivellatomariotretre33 · 22 Ottobre 2015

Ciao Mike58 mi servirebbe uno script che a ogni estrazione nel quadro estrazionale su tutte le 11 ruote mi evidenzia in rosso il numero più grande e il numero più piccolo della stessa Cadenza .se possibile con tabella grazie di cuore magari se si può fare con imput la scelta dell'estrazione. per favore se puoi.

Mike58 · 22 Ottobre 2015

Prova cosi

Codice:

Sub Main

Dim nu(5),ru(12),num(2)

qt = InputBox("Quante estrazioni controllo",,10)

fin = EstrazioneFin

Scrivi "Evidenzia Ambo e superiore in Cadenza ",1,1,,1,4,,1

Scrivi

For es = fin To fin - qt Step - 1

Scrivi GetInfoEstrazione(es),1

'Scrivi

ReDim Tt(6)

Tt(1) = " Ruota "

Tt(2) = " E1 "

Tt(3) = " E2 "

Tt(4) = " E3 "

Tt(5) = " E4 "

Tt(6) = " E5 "

Call InitTabella(Tt,1,,3,5,"Arial Black")

For r = 1 To 12

If r = 11 Then r = 12

For p = 1 To 5

nu(p) = Estratto(es,r,p)

Next

For p1 = 1 To 4

For p2 = p1 + 1 To 4

a = Estratto(es,r,p1)

b = Estratto(es,r,p2)

Next

Next

If Cadenza(a) = Cadenza(b) Then

num(1) = a

num(2) = b

End If

ReDim Vv(6)

Vv(1) = NomeRuota(r)

Vv(2) = nu(1)

Vv(3) = nu(2)

Vv(4) = nu(3)

Vv(5) = nu(4)

Vv(6) = nu(5)

Call AddRigaTabella(Vv,,,3,0,"arial black")

For x = 2 To 6

For y = x + 1 To 6

If Cadenza(Vv(x)) = Cadenza(Vv(y)) Then Call SetColoreCella((x),2,4)

If Cadenza(Vv(y)) = Cadenza(Vv(x)) Then Call SetColoreCella((y),2,4)

'If Cadenza(Vv(x)) = Cadenza(Vv(y))And Massimo(Vv(x),Vv(y)) Then Call SetColoreCella((x),4,2)

'If Cadenza(Vv(y)) = Cadenza(Vv(x)) And Massimo(Vv(y),Vv(x)) Then Call SetColoreCella((y),2,4)

Next

Next

Next

CreaTabella

Next

End Sub

trivellatomariotretre33 · 23 Ottobre 2015

CIAO MIKE58 GRAZIE PER LO SCRYPT MI E UTILE ANCHE QUESTO !
PERO CIO CHE INTENDEVO IO CHE SUL QUADRO ESTRAZIONALE DEL 22 OTTOBRE MI DEVE EVIDENZIARE IL NUMERO PIU GRANDE DELLE 11 RUOTE E CIOE IN QUESTO CASO 89 SU MILANO IN TERZA POSIZIONE E POI IL PIU PICCOLO DELLA STESSA CADENZA IL 29 SU MILANO TORINO GRAZIE ANTICIPATAMENTE

Mike58 · 23 Ottobre 2015

Ho capito meglio, purtroppo adesso mi manca il tempo,
Comunque quando rientro stasera tardi cercherò di correggere il tutto.

ciao

trivellatomariotretre33 · 23 Ottobre 2015

Grazie Mike58

Joe91 · 23 Ottobre 2015

Aspettando ... propongo una interpretazione di quanto sembra esssere all'oggetto:

Codice:

[B][SIZE=10px]9069 - 15.10.2015[/SIZE][/B]

[FONT=Courier New][SIZE=10px][COLOR=#000000][B]BA [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]77 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]01 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]13 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]23 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]56 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]CA [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]38 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]40 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]72 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]26 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]51 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]FI [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]32 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]37 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#ff0000][B]87 [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]24 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]65 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]GE [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]62 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]84 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#ff0000][B]87 [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]38 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]26 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]MI [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]73 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]43 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]82 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]09 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]16 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]NA [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]84 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]29 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]34 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]18 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]03 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]PA [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]21 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]66 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]73 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]26 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]01 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]RO [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]11 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]72 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]04 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]38 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]70 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]TO [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]16 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]46 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#ff0000][B]87 [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]65 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]84 [/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]VE [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]70 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]29 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]48 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]38 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#ff0000][B]07 [/B][/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=10px][COLOR=#000000][B]NZ [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#ff0000][B]07 [/B][/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]38 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]63 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]14 [/COLOR][/SIZE][/FONT][FONT=Courier New][SIZE=10px][COLOR=#000000]15 [/COLOR][/SIZE][/FONT]

trivellatomariotretre33 · 23 Ottobre 2015

si Joe91 esatto

i legend · 23 Ottobre 2015

Ciao joe per curiosità hai messo tutto in un arRay è usato le funzioni massimo , minimo?
Chiedo non mi ci sono messo.
Ciao

Joe91 · 23 Ottobre 2015

Buona Sera a tutte/i.

x i legend:

No. Ho utilizzato il minibrowser che avevo già proposto qui per la visualizzazione.

Poi i numeri da evidenziare li ho calcolati con due nuove funzioni.

La prima cerca semplicemente il massimo dei numeri estratti.

La seconda ritrova la più piccola cadenza ... ad esso ricollegabile.

In sintesi ... è un programma di 3 righe.

i legend · 23 Ottobre 2015

Fatto

Salvo errori di battitura
Esiste una funzione che carica tutti gli estratti in una volta sola?
Sicuramente è ottimizzabile

Codice:

Sub main 
Dim r, p, i
Dim max,min
Dim idestr 
Dim cad, e 
Redim  aEstr (55)
Idestr = estrazionefin  ' si può cambiare 
Cad =3 ' si può cambiare da InputBox 
For r = 1 To 12 
If r=11 Then r  =12

For p = 1 To 5
If cadenza (estratto  ( idestr, r, p ) )=cad  then 
i=i +1
Aestr (i)=estratto  ( idestr, r, p ) 
End if
Next 
Next 
Call eliminaripetuti  (Aestr, true)
Scrivi "Estratti di cadenza : "&cad
Scrivi stringanumeri ( aestr, ,true ) ,1
Scrivi 
Max =massimov (aestr)
Min=minimov (aestr, 1)
For  r = 1 To 12 
If r = 11 Then r = 12 
Scrivi  siglaruota ( r )& " ",1,false
For p = 1 To 5
E =estratto  ( idestr, r, p ) 
If e= min  or e=max then 
Scrivi format2 ( e)&" ",1,false, ,vb red
Else
Scrivi  format2 ( e)&"  ",,false
End  if
Next 
Scrivi 
Next
End sub

i legend · 24 Ottobre 2015

Ciao joe quando ho scritto non avevo visto il tuo intervento altrimenti non avrei postato il mio papiro
.
Cercherò di seguire il tuo esempio
Ciao e grazie per gli input

trivellatomariotretre33 · 24 Ottobre 2015

grazie a tutti va bene solo se si potrebbe metterli in colonna e a scelta input estrazione e cadenza .
poi il risultato sommarlo . poi meno 90 e giocare l'ambata e il vertibile sulle ruote evidenziate in rosso dal grande a piccolo

Joe91 · 24 Ottobre 2015

Buon giorno a tutte/i.

Ho rimodulato lo script di ilegend ... per sommi capi ... sulle linee guida che avevo indicato.

Come si vede la proposta di inputbox è stata sosituita da una routine ...

che autodetermina la cadenza di cui fare oggetto per le successive valutazioni.

Era evidente la mancanza d'interesse ludico e da questo derivava

il poter escludere, la parte tabellare richiesta ed in sua vece, ricavare le ruote coinvolte nella ricerca.

Dunque avevo predisposto il codice ... per rendere più agevole tutto quanto sinora esposto.

Come qui di seguito riportato:

Codice:

Option Explicit
Sub Main
	Dim idEstr
	Dim Cad,E
	Dim Max,Min
	idEstr = EstrazioneFin
	Call MaggioreEstratto(idEstr,E)
	Cad = Cadenza(E)
	Call Estremi(idEstr,Cad,Max,Min)
	Call MiniBrowser(idEstr,Max,Min)
End Sub
Sub MaggioreEstratto(idEstr,E)
	Dim R,P,Mx
	For R = 1 To 12
		If R = 11 Then R = 12
		For P = 1 To 5
			E = Estratto(idEstr,R,P)
			If E > Mx Then Mx = E
		Next
	Next
	E = Mx
End Sub
Sub Estremi(idEstr,Cad,max,min)
Dim R,P,I
	For R = 1 To 12
		If R = 11 Then R = 12
		For P = 1 To 5
			If Cadenza(Estratto(idEstr,R,P)) = Cad Then
				I = I + 1
				ReDim Preserve aEstr(I)
				aEstr(I) = Estratto(idEstr,R,P)
			End If
		Next
	Next
	Call EliminaRipetuti(aEstr,True)
	Scrivi "Estratti di cadenza : " & Cad
	Scrivi StringaNumeri(aEstr,,True),1
	Scrivi
	max = MassimoV(aEstr)
	min = MinimoV(aEstr,1)
End Sub
Sub MiniBrowser(idEstr,Min,Max)
	Dim R,P,E,Ru(12)
	For R = 1 To 12
		If R = 11 Then R = 12
		Scrivi SiglaRuota(R) & " ",1,False
		For P = 1 To 5
			E = Estratto(idEstr,R,P)
			If E = Min Or E = Max Then
				Scrivi Format2(E) & Space(1),True,False,,vbRed
				Ru(R) = R
			Else
				Scrivi Format2(E) & Space(1),False,False
			End If
		Next
		Scrivi
	Next
	Scrivi "Ruote " & StringaNumeri(Ru)
End Sub

i legend · 24 Ottobre 2015

Bello joe grazie , la ricerca del max con sostituzioni .e velocissima. Non gioco al lotto questo scambiare ed apprendere è una gioia, un adrenalina che dura più di qualche secondo che precede le estrazioni. Almeno per quanto mi riguarda

Ciao

Mike58 · 24 Ottobre 2015

Ciao a tutti, grazie a Joe e i legend, per l'aiuto , infatti ero un po' in difficoltà nella ricerca dei NumeriVettori
massimo e minimo in cadenza.

Per dire la mia avevo seguito la via del MassimoE che trovava il massimo Estratto sulle 11 ruote ma poi avevo difficoltà a isolare il numero Minimo in stessa cadenza.

Purtroopo il tempo causa lavoro non è dalla mia potreste completare il tutto per la richiesta definitiva di Trivellato.

Ciao a tutti.

Joe91 · 24 Ottobre 2015

Ciao Mike ...

Di questa richiesta mi interessava solo tradurre in codice la parte "difficile".

Poi ho predispossto lo script stesso, affinchè fosse facile e possibile ricavarci i numeri e le ruote.

Formare un eventuale pronostico ... lo lascio, a chi lo vorrà fare.

In ogni caso da parte mia è no ... almeno sino a quando, prima,

non ci siano indicazioni precise e complete di esempi pratici.

Non è per cattiveria e/o presunzione ma per evitare a tutti noi

inutili incomprensioni e perdite di tempo ... nell'aggiustare reiteratamente i pronostici.

Questa l'automazione a medodo (attualmente prodotta):

====================
15.10.2015
Numeri 7.87
Ruote 3.4.9.10.12
====================
17.10.2015
Numeri 5.85
Ruote 1.5.12
====================
20.10.2015
Numeri 69.89
Ruote 5.9
====================
22.10.2015
Numeri 29.89
Ruote 5.9
====================

Buona Domenica a tutte/i.

i legend · 25 Ottobre 2015

Ciao Mike , joe, trivellato, tutti.
Concordo con joe per quanto concerne l ultima richiesta.
Non capisco perché le richieste si fanno a pezzi.
Sarebbe più facile pensare lo script sapendo la sua finalità.
Cmq se si spiega chiaramente non ho problemi a cercare di scrivere il listato.
HO pensato uno script alternativo seguendo il ragionamento di mike:
Mike ecco una possibile soluzione
:

Codice:

Sub main 
Dim idestr 
Dim eMax, eMin
Idestr= cint ( InputBox ( " inserisci concorso ", " Data Ricerca ",estrazionefin ) ) 
eMax =massimoe (idestr ) 
Call trovaMin (idestr, eMax, eMin)
Call minibrowers (idestr, eMax, eMin )
End sub 
Sub trovaMin (idestr, eMax, eMin )
Dim  r, k
Dim aMin (11)
For  r = 1 To 12 
If r = 11 Then r = 12 
K = k+ 1 
aMin  (k ) = minimoE (idestr, cint (r ) )
Next 
Call ordinaMatrice ( aMin,1)
For k = 1 To ubound ( aMin)
If cadenza ( aMin  (k))=cadenza  ( eMax ) Then 
eMin=amin (k)
Exit For 
Else 
eMin = " __"
End  if
Next
End sub

Se si fa il confronto nel primo ciclo il secondo non serve

Codice:

FOR  R = 1 TO 12 
IF R = 11 THEN R = 12 
If cadenza ( eMax ) = cadenza ( minimoE ( idestr, cint ( r ) )  Then 
K = k + 1 
Redim preserv aMin ( k ) 
aMin ( k ) = minimoE ( idestr, cint ( r ) ) 
End if 
Next 
Call ordinaMatrice ( aMin, 1 ) 
If ubound ( aMin ) > 0 Then 
eMin = minimov ( amin, 1 ) 
Else 
eMin =" "
End if

La sub minibrowers è quella scritta da joe
Quella sub già seleziona le ruote quindi il passo per la richiesta di trivellAto è breve.
Ciao a tutti.
Mike fammi sapere se questa era la strada che volevi percorrere.
Ciao

i legend · 25 Ottobre 2015

La nuova funzione trova minimo se si fa un ciclo idestr importante va in overflaw .non capisco perché. Non so che azzerare.
Help

Mike58 · 25 Ottobre 2015

Ciao Legend, per ora non mi funziona anche messo insieme, comunque io seguivo la via del MassimoE, e poi cercavo il minimo in cadenza(ancora con qualche difficoltà) a farlo ex.mio.
Poi sia tu che joe avete risolto con dei cicli diversi dal main menù-

Devo solo metterli insieme a mdo mio, ma poi vedo che la richiesta e finalità era anche un altra e quindi si può anche seguire una via diversa,

Mi scuso ma questo è un week end lavorativo e mi manca tempo e lucidità, domani gg di riposo posso magari trovare il tempo e lucidità necessaria, nel frattempo un saluto a tutti.

ciao

PER MIKE58

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Premium Member

Advanced Member >PLATINUM PLUS<

Premium Member

Premium Member

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Premium Member

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Premium Member

Premium Member

Advanced Member >PLATINUM PLUS<