xMike58...richiesta modifica listato....

[Zetrix]

                                           [CODE]                       Sub Main()
T = "***** SOMME E DISTANZE TRA GLI ESTRATTI BY BLACKMORE *****"
Call Scrivi(T & K,True,,vbBlue,5,4):Scrivi
Scrivi "Questo Script mostra somme e distanze tra gli estratti",1,,,,3
Scrivi "nella stessa Posizione su 2 ruote a scelta, evidenziando",1,,,,3
Scrivi "le somme e le distanze uguali multiple(Ambi Isotopi stessa somma e/o distanza)",1,,,,3 :Scrivi
ReDim title(15)
title(1) = " Data "
title(2) = " 1°Ruota "
title(3) = " 1°Ruota "
title(4) = " Estratti 1°Ruota "
title(5) = " Estratti 1°Ruota "
title(6) = " Som 1° "
title(7) = " Som 2° "
title(8) = " Som 3° "
title(9) = " Som 4° "
title(10) = " Som 5° "
title(11) = " Dis 1° "
title(12) = " Dis 2° "
title(13) = " Dis 3° "
title(14) = " Dis 4° "
title(15) = " Dis 5° "
Call InitTabella(title,RGB(116,116,116),,2,5)
r1 = CInt(InputBox("SCEGLI LA 1° RUOTA DI RICERCA",,1))
r2 = CInt(InputBox("SCEGLI LA 2° RUOTA DI RICERCA",,1))
ii = InputBox("QUANTE ESTRAZIONI VUOI ESAMINARE ?",,30)
fin = EstrazioneFin
Ini = fin - ii
For es = Ini To fin

som1 = Fuori90(Estratto(es,r1,1) + Estratto(es,r1,2))
som2 = Fuori90(Estratto(es,r1,1) + Estratto(es,r1,3))
som3 = Fuori90(Estratto(es,r1,1) + Estratto(es,r1,4))
som4 = Fuori90(Estratto(es,r1,1) + Estratto(es,r1,5))
'som5 = Fuori90(Estratto(es,r1,1) + Estratto(es,r1,5))
dis1 = Distanza(Estratto(es,r1,1),Estratto(es,r1,2))
dis2 = Distanza(Estratto(es,r1,1),Estratto(es,r1,3))
dis3 = Distanza(Estratto(es,r1,1),Estratto(es,r1,4))
dis4 = Distanza(Estratto(es,r1,1),Estratto(es,r1,5))
'dis5 = Distanza(Estratto(es,r1,1),Estratto(es,r1,5))
If dis1 = 90 Then dis1 = 0
If dis2 = 90 Then dis2 = 0
If dis3 = 90 Then dis3 = 0
If dis4 = 90 Then dis4 = 0
If dis5 = 90 Then dis5 = 0
ReDim Value(15)
Value(01) = DataEstrazione(es)
Value(02) = NomeRuota(r1)
Value(03) = NomeRuota(r2)
Value(04) = StringaEstratti(es,r1)
Value(05) = StringaEstratti(es,r2)
Value(06) = som1
Value(07) = som2
Value(08) = som3
Value(09) = som4
Value(10) = som5
Value(11) = Dis1
Value(12) = Dis2
Value(13) = Dis3
Value(14) = Dis4
Value(15) = Dis5
Call AddRigaTabella(Value,,,4,,1)
Call SetColoreCella(1,RGB(116,116,116),5)
Call SetColoreCella(2,RGB(239,239,239),1)
Call SetColoreCella(3,RGB(251,251,251),RGB(217,0,0))
Call SetColoreCella(4,RGB(239,239,239),1)
Call SetColoreCella(5,RGB(251,251,251),RGB(217,0,0))
Call SetColoreCella(6,vbYellow)
Call SetColoreCella(7,vbYellow)
Call SetColoreCella(8,vbYellow)
Call SetColoreCella(9,vbYellow)
Call SetColoreCella(10,vbYellow)
Call SetColoreCella(11,vbCyan)
Call SetColoreCella(12,vbCyan)
Call SetColoreCella(13,vbCyan)
Call SetColoreCella(14,vbCyan)
Call SetColoreCella(15,vbCyan)

If som5 = som4 Then: Call SetColoreCella(10,RGB(223,0,223),5):If som5 = som4 Then Call SetColoreCella(9,RGB(223,0,223),5)
If som5 = som3 Then: Call SetColoreCella(10,RGB(223,0,223),5):If som5 = som3 Then Call SetColoreCella(8,RGB(223,0,223),5)
If som5 = som2 Then: Call SetColoreCella(10,RGB(223,0,223),5):If som5 = som2 Then Call SetColoreCella(7,RGB(223,0,223),5)
If som5 = som1 Then: Call SetColoreCella(10,RGB(223,0,223),5):If som5 = som1 Then Call SetColoreCella(6,RGB(223,0,223),5)
If som4 = som3 Then: Call SetColoreCella(9,RGB(223,0,223),5):If som4 = som3 Then Call SetColoreCella(8,RGB(223,0,223),5)
If som4 = som2 Then: Call SetColoreCella(9,RGB(223,0,223),5):If som4 = som2 Then Call SetColoreCella(7,RGB(223,0,223),5)
If som4 = som1 Then: Call SetColoreCella(9,RGB(223,0,223),5):If som4 = som1 Then Call SetColoreCella(6,RGB(223,0,223),5)
If som3 = som2 Then: Call SetColoreCella(8,RGB(223,0,223),5):If som3 = som2 Then Call SetColoreCella(7,RGB(223,0,223),5)
If som3 = som1 Then: Call SetColoreCella(8,RGB(223,0,223),5):If som3 = som1 Then Call SetColoreCella(6,RGB(223,0,223),5)
If som2 = som1 Then: Call SetColoreCella(7,RGB(223,0,223),5):If som2 = som1 Then Call SetColoreCella(6,RGB(223,0,223),5)

If dis5 = dis4 Then: Call SetColoreCella(15,RGB(150,75,75),5):If dis5 = dis4 Then Call SetColoreCella(14,RGB(150,75,75),5)
If dis5 = dis3 Then: Call SetColoreCella(15,RGB(150,75,75),5):If dis5 = dis3 Then Call SetColoreCella(13,RGB(150,75,75),5)
If dis5 = dis2 Then: Call SetColoreCella(15,RGB(150,75,75),5):If dis5 = dis2 Then Call SetColoreCella(12,RGB(150,75,75),5)
If dis5 = dis1 Then: Call SetColoreCella(15,RGB(150,75,75),5):If dis5 = dis1 Then Call SetColoreCella(11,RGB(150,75,75),5)
If dis4 = dis3 Then: Call SetColoreCella(14,RGB(150,75,75),5):If dis4 = dis3 Then Call SetColoreCella(13,RGB(150,75,75),5)
If dis4 = dis2 Then: Call SetColoreCella(14,RGB(150,75,75),5):If dis4 = dis2 Then Call SetColoreCella(12,RGB(150,75,75),5)
If dis4 = dis1 Then: Call SetColoreCella(14,RGB(150,75,75),5):If dis4 = dis1 Then Call SetColoreCella(11,RGB(150,75,75),5)
If dis3 = dis2 Then: Call SetColoreCella(13,RGB(150,75,75),5):If dis3 = dis2 Then Call SetColoreCella(12,RGB(150,75,75),5)
If dis3 = dis1 Then: Call SetColoreCella(13,RGB(150,75,75),5):If dis3 = dis1 Then Call SetColoreCella(11,RGB(150,75,75),5)
If dis2 = dis1 Then: Call SetColoreCella(12,RGB(150,75,75),5):If dis2 = dis1 Then Call SetColoreCella(11,RGB(150,75,75),5)

Next
Call CreaTabella()
End Sub

[/CODE]

 

[Zetrix]

Ciao Mike ..il listato allegato e di Blackmore ..ho fatto una piccola modifica al listato..per quello che interessa a me...solo su bari
ti volevo chiedere e possibile inserire un altro prospetto facendo la som/+/dis...in modo che risulti
in una est som/+/dis uguali ..vedi esempio 12/mag/ ....su ba... ..som/50.....
mi serve per definire la tecnica e quali sono gli abb per ambo .....
su out si puo eliminare il secondo prospetto dei cinque estratti...
nn serve basta uno..in pratica lo script mi deve dire su quale est si ripete la somma uguale ..poiche devono corrispondere tutti e quattro valori uguali.....questa poi diviene l'ambata in gioco per 6clp sulla ruota di bari...
se mi metto io a fare le modifiche poi dopo combino pasticcio..
in sostanza ce da aggiung un altro prospetto in out del listato...
esempio ..som1/+dis1/ valore x ..e via di seguito.....

 

[Mike58]

Si Zetrix, è possibile fare questo listato che chiedi, solo che non ho capito bene quello che esattamente ti serve.
Con tutti i tuoi prospetti esaustivi proprio ora ti metti a fare il sintetico.

Come puoi immagginare ci sono 10 somme di tutte le posizioni e 10 distanze o differenza (quale scegli ? ) poi queste possono essere sommati e evidenziare se sono uguali.

Come vedi dallo script postato questo somma gli estratti in posizione della 1 ruota con la stessa posizione della 2 ruota e fa lo stesso con le differenza (in questo caso distanza).

Dai fammi capire con un bel prospetto come lo vorresti in output, mi basta un bel esempio reale.
Non ti preoccupare lo script è fattibilissimo.

Ciao

 

[Zetrix]

Ciao Mike grazie per l'interesse del listato ..lo so che avresti trovato difficolta purtroppo
spiegare sul forum e un impresa e piu facile a dirlo ..vabbe domani vedro di mettere un esempio
di come vorrei l'out del listato ... ora se fatto tardi ... domani mattina vedro di sistemare tutto..
Buonanotte

 

[Zetrix]

Ciao Mike ...questo e il prospetto che vorrei in out .....il listato di Blackmore lo gia modificato in parte ..
quello che resta da fare e creare un altro specchietto che visualizza il valore x come si evince dal disegno
poi rimane da definire per trovare l'ambo da mettere in gioco.......ma per ora basta questo prospetto...
p.s ho notato che il 50 uscito a ba. si e formato l'ambo con uno dei dieci ambi somma ... dei cinque estratti......
nota .. puoi lasciare invariato i due prospetti giallo e blu oppure se vuoi li puoi togliere ..a me interessa in out del listato che mi visualizza le relative somme x come descritto nel disegno > prospetto da fare som/1-2 + dis/1-2

 

[Mike58]

Ciao Zetrix, sono di fretta (lavoro in Pressing) ho riveduto ex novo il tutto è chiaro che può fare di meglio e con le dovute risultanze finali ottimizzate.

Intanto per le tue ricerche prova cosi.

Se ci sono variazioni da fare non c'è problema, sappi e lo ripeto che le tue proposte sono apprezzate da parte mia, quindi massima collaborazione.

Sub Main

Dim nu(5),ru(1)

Dim T,V

r = 1

ru(1) = r

Ini = EstrazioneFin - 100

fin = EstrazioneFin

Scrivi "SOMME ESTRATTI + DISTANZE ed EVIDENZIA RISULTANZE UGUALI ****** Ricerca BY Zetrix **** Script By Mike58 ***** ",1,1,,1,4

Scrivi

T = Array(T,"Ruota","Data Estraz.","Estratti","Sm 1+2","Sm 1+3","Sm 1+4","Sm 1+5","Sm 2+3","Sm 2+4","Sm 2+5","Sm 3+4","Sm 3+5","Sm 4+5","D 1+2","D 1+3","D 1+4","D 1+5",_

"D 2+3","D 2+4","D 2+5","D 3+4","D 3+5","D 4+5","SD1","SD2","SD3","SD4","SD5","SD6","SD7","SD8","SD9","SD10")

Call InitTabella(T,2,,2,5,"arial black")

For es = Ini To fin

For p = 1 To 5

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

Next

'........ somme ................

s1 = Fuori90(nu(1) + nu(2))

s2 = Fuori90(nu(1) + nu(3))

s3 = Fuori90(nu(1) + nu(4))

s4 = Fuori90(nu(1) + nu(5))

's5 = Fuori90(nu(2) + nu(3))

's6 = Fuori90(nu(2) + nu(4))

's7 = Fuori90(nu(2) + nu(5))

's8 = Fuori90(nu(3) + nu(4))

's9 = Fuori90(nu(3) + nu(5))

's10 = Fuori90(nu(4) + nu(5))

'...............................

'....... distanze.............

d1 = Distanza(nu(1),nu(2))

d2 = Distanza(nu(1),nu(3))

d3 = Distanza(nu(1),nu(4))

d4 = Distanza(nu(1),nu(5))

'd5 = Distanza(nu(2),nu(3))

'd6 = Distanza(nu(2),nu(4))

'd7 = Distanza(nu(2),nu(5))

'd8 = Distanza(nu(3),nu(4))

'd9 = Distanza(nu(3),nu(5))

'd10 = Distanza(nu(4),nu(5))

'...............................

'..... somme + distanze...........

sd1 = Fuori90(s1 + d1)

sd2 = Fuori90(s2 + d2)

sd3 = Fuori90(s3 + d3)

sd4 = Fuori90(s4 + d4)

'sd5 = Fuori90(s5 + d5)

'sd6 = Fuori90(s6 + d6)

'sd7 = Fuori90(s7 + d7)

'sd8 = Fuori90(s8 + d8)

'sd9 = Fuori90(s9 + d9)

'sd10 = Fuori90(s10 + d10)

V = Array(V,NomeRuota(r),DataEstrazione(es),StringaNumeri(nu,,1),s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,d1,d2,d3,d4,d5,d6,d7,d8,d9,d10,sd1,sd2,sd3,sd4,sd5,sd6,sd7,sd8,sd9,sd10)

If(sd1 + sd2 + sd3 + sd4)/4 = sd4 Then ' se si vuole tutte le risultanze mettere apice

Call AddRigaTabella(V,,,2,,"arial black")

For x = 4 To 13

Call SetColoreCella((x),4,0)

Next

For y = 14 To 23

Call SetColoreCella((y),6,0)

Next

For x1 = 24 To 27

For x2 = x1 + 1 To 27

If V(x1) = V(x2) Then Call SetColoreCella((x1),7,5)

If V(x2) = V(x1) Then Call SetColoreCella((x2),7,5)

'Call SetColoreCella((x1),2,4)

Next

Next

End If ' chiusura end filtro = 4

Next

Call SetTableWidth("100%")

CreaTabella

'End If

End Sub

 

[Zetrix]

Ciao Mike58 ho eseguito lo script ma da errore ...ho spaziometria versione 1.5.15 sara dovuto a questo..nn so...forse devo installare l'ultim versione..1.5.20...adesso provo il setup poi ti faro sapere....

 

[Zetrix]

Ciao Mike58 ho fatto il setup spaziometria 1.5.20 ..ho eseguito diversi script ma danno tutti questo errore...con la versione 1.5.15 nn davano questi errori andava tutto bene ..tranne l'ultimo listato...che da sempre lo stesso errore di sintassi...

 

[LuigiB]

zetrix scusatemi tutti .. c'era un errore nell'ultima versione .. scaricate la 1.5.21

 

[Zetrix]

Ciao LuigiB .. fatto il setup 1.5.21 .... alla fine del setup dice sempre che potrebbe essere compromesso il programma spazioMetria .... ma nn so perche le ultime versioni nn hanno piu la funzione dereg..
ho installato il controllo script visual vb pero nn entra in funzione con le ultime versioni...solo con la 1.5.15 entrava in funzione la dereg...
ma a parte questo volevo dire che il listato che ha fatto Mike58 da sempre errore di sintassi ...
come da esempio preced allegato .....

xMike58 ho provato anche con l'ultima versione niente da fare nn si esegue lo script ..ce qualcosa che nn va nel listato.. fammi sapere cosa si puo fare ....oppure dobbiamo abbandonare il progetto......

 

[rudivall]

T = Array(T,"Ruota","Data Estraz.","Estratti","Sm 1+2","Sm 1+3","Sm 1+4","Sm 1+5","Sm 2+3","Sm 2+4","Sm 2+5","Sm 3+4","Sm 3+5","Sm 4+5","D 1+2","D 1+3","D 1+4","D 1+5",_ "D 2+3","D 2+4","D 2+5","D 3+4","D 3+5","D 4+5","SD1","SD2","SD3","SD4","SD5","SD6","SD7","SD8","SD9","SD10") Zetrix, vedi queste due linee di codice, mettile tutte e due su una sola linea, prova....

 

[Mike58]

Zetrix, non saprei perché non ti funziona, quello che io posso dirti, vedi nel caso hai attivo option explicit, io non lo uso e tutte le variabili non sono dichiarate in Dim.

Sono sicuro che risolverai presto, sicuramente non è il listato io lo leggo anche con l'iltima versione scaricata 1.5.21

 

[Zetrix]

T = Array(T,"Ruota","Data Estraz.","Estratti","Sm 1+2","Sm 1+3","Sm 1+4","Sm 1+5","Sm 2+3","Sm 2+4","Sm 2+5","Sm 3+4","Sm 3+5","Sm 4+5","D 1+2","D 1+3","D 1+4","D 1+5",_ "D 2+3","D 2+4","D 2+5","D 3+4","D 3+5","D 4+5","SD1","SD2","SD3","SD4","SD5","SD6","SD7","SD8","SD9","SD10") Zetrix, vedi queste due linee di codice, mettile tutte e due su una sola linea, prova....

Ciao rudivall ho provato a metterle sulla stessa linea e lo script ha funzionato ....
ecco perche dava l'errore era proprio su quella linea che dava l'errore di sintassi
perche il codice veniva spezzato su due linee..... grazie del tuo aiuto.....

 

[Zetrix]

Zetrix, non saprei perché non ti funziona, quello che io posso dirti, vedi nel caso hai attivo option explicit, io non lo uso e tutte le variabili non sono dichiarate in Dim.

Sono sicuro che risolverai presto, sicuramente non è il listato io lo leggo anche con l'iltima versione scaricata 1.5.21

Ciao Mike ho risolto il problema grazie a rudivall ... in pratica il codice che inizia con T array veniva
posto su due lineee e lo script mi dava l'errore di sintassi proprio su quella linea ....quindi nn era il listato era solo che era disposto una linea in modo errato.... grazie Mike della collaborazione ho visto l'out del listato
perfetto nn ci sono errori ..ora vedro di portare a termine il progetto sia per ambata che per ambo.....
spero di contare sul tuo aiuto ...su di me puoi contare hai un ottimo alleato ....

p.s nn so cosè la funzione option explicit e nn so nemmeno dove si trova..

 

[LuigiB]

Ciao Zetrix , il deregistra non c'è piu non ti preoccupare .. non ti preoccupare nemmeno dei vari messaggi del setup la prova che conta è che il programma effettivamente funzioni.
Nella versione 20 c'era comunque un errore risolto con la 21 .. poi in questo caso specifico c'era anche il problema della riga spezzata.

 

[Zetrix]

Ciao LuigiB ho provato la versione 1.5.21 sembra per ora che nn da problemi ..
me ne sono accorto la dereg che nn va piu vabbe ignoro le finestre di windos e porto
avanti il setup .. per quanto riguarda la riga spezzata nn sono molto pratico con gli script
ma ora ho capito come funziona gli script in pratica ci sono tante linee e ad ognuna
ce una riga di comando ..per questo dava errore di sintassi perche nn leggeva tutta la riga intera
ma grazie a rudivall ho risolto il problema .. E un grazie va anche a Mike58 per aver fatto il listato..
su mia richiesta... l'out del prospetto e fatto molto bene.......e se lo dice zetrix vuol dire che e cosi.... se nn era fatto bene lo avrei detto anche...
la prima cosa che guardo e l'aspetto estetico del out del listato....
e cosi per tutte le altre cose...

 

[Mike58]

Ciao zetrix, intanto sono contento per l'apprezzamento e come te anche per me l'ordine e l'aspetto estetico, è cosa primaria,anche se ulteriormente migliorabile e personalizzabile.

Ti rispondo anche per l'errore riscontrato visto che l'ho creato io sul mio pc la stessa riga funziona anche spezzata, infatti il carattere " _ " congiunzione a capo di un testo serve per scrivere su 2 o più righe un test altrimenti fuori dalla schermata ed è corretta cosi.

Tuttavia incollata dal forum è un carattere che il vbscript rischia di non riconoscere ( sarà un problema del code del forum) altre volte i caratteri o operatori logici > < = & hanno avuto problemi di lettura e venivano cambiati in forme illeggibili che non facevano e fanno tuttora non funzionare molti script.

Io me la cavo e riconosco il problema ma in tanti rischiano di perdersi per poco.

Ciao

 

[Zetrix]

Ciao Mike58 in effetti e come dici tu ..quando ho fatto il copia incolla del listato nella pagina script di spazioMetria nell eseguire lo script mi dava l'errore proprio sulla linea 20 dove si trovava la lineetta _
per cui ho cancellato la lineetta _ e ho eseguito di nuovo lo script ma ridava l'errore sempre sulla linea 20
quindi alla fine il problema si era risolto con il ripristino della riga di comando sulla stessa linea ..
Mike hai visto ieri e uscito il 38 a ba. peccato che nn si e abbinato con uno dei dieci ambi somma ..
per cui ce ancora da studiare .... nell 'est del 3/6/15 vi era un prospetto che si otteneva l'ambo 38.74 su ba.
questa tecnica si chiama collage ..purtroppo ieri ho preso solo il 38 a ba.
poi quanto ho tempo ti faro vedere il disegno con la tecnica collage........

 

[Zetrix]

xMike58 questo e il disegno per 38.74... per ottenere questo ambo si usa la tecnica collage.....ho provato a fare questo prospetto spero che si riesca a comprendere il disegno quanto due chiusure sono sovrapposte nella stessa casella entra in gioco la tecnica collage....meglio se i numeri sono della stessa figura....nel caso 38.74 sono di fig2.....

 

[Mike58]

Zetrix, il disegno è chiaro dei 2 triangoli trovati, ma !!! il ragionamento per il 38-74 No !!!

1. trovi ambo in figura 4 a bari 40-13
2. trovi diametrale 85 a Mi e 58 a Ca, unita in ambo di figura 2, 83 a ca e 29 a Mi
3. come ricavi questo 38.74 ?

sono sicuro che per te è chiaro, ma cosa ha a che fare con il 38 trovato nello script delle evidenze ?

A me sorge una domanda ma queste triangolazioni non si possono trovare con gli script impostando le dovute condizioni e verificarne poi gli esiti ai fini della tecnica.

Comunque se la tecnica ha dato ambo a colpo merita approfondimento,

Ciao