Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Guarda meglio in archivio...Imaging dovrei avere diversi script con le distanze continuative sulle estrazioni..
ma non calcolate in due estrazioni..
Ringrazio PatrisciaComplimenti ancora, bravo
Si è cosi negli appunti non ho visto le date e ho scritto come esempio per capirci nella spiegazione. Roma in questa ricerca non fa parte del metodo la ricerca è su una ruota. La ricerca nell'estrazione precedente del 07/05/.....il terzo numero ma sempre sulla stessa ruota in questo caso PALERMO.Hai sbagliato la data dell'esempio ... ma non è un problema.
Ci sono diverse soluzioni ed alcune sono diverse-diverse.
Comunque sia, trascurando altre ricerche e dando per acquisito che i numeri ci siano ad esempio :
10.05.2011 PA 59.85+33
10.05.2011 RO 57.83 +19
Se ho capito bene ordini i numeri e poi cerchi il precedente in distanza al "più piccolo" (PA_33 e RO_19)
e poi il seguente al più grande (PA_85 e RO_83) ?
Oppure la ricerca degli altri numeri è differente?
Option Explicit
Sub Main
Dim Caso,Casi,R1,R2,P1,P2,P3,P4,P5,x
Dim E1,E2,S1,S2,S3,A,B,C,FIn,Es,Ini,Dist
Dim M_M1,MM_M1,MMM_M1,P_M2,PP_M2,PPP_M2
Dim M(2),Com(7)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,10110)
Dist = CInt(InputBox("Inserisci la Distanza tra i due Estratti - MAX 44?",,26))
Scrivi Space(15) & " METODO DISTANZA " & Format2(Dist) & " POSTATO da IMAGING - Script Salvo50" & Space(15),1,,4,,3,,1
Call ScegliRange(Ini,FIn,Ini,FIn)
For Es = Ini To FIn
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
If Distanza(A,B) = Dist Then
M(1) = A : M(2) = B
OrdinaMatrice M,1
For P3 = 1 To 5
C = Estratto(Es - 1,R1,P3)
If A <> C And B <> C Then
M_M1 = Fuori90((90 + M(1)) - Dist)
P_M2 = Fuori90(M(2) + Dist)
S1 = ""
S2 = ""
S3 = ""
If C = M_M1 Or C = P_M2 Then
If C = M_M1 Then
MM_M1 = Fuori90((90 + C) - Dist)
MMM_M1 = Fuori90((90 + MM_M1) - Dist)
P_M2 = Fuori90(M(2) + Dist)
PP_M2 = Fuori90(P_M2 + Dist)
S1 = S1 & Format2(M_M1) & " " & Format2(M(1)) & " " & Format2(M(2))
S2 = S2 & Format2(MM_M1) & Space(10) & Format2(P_M2)
S3 = S3 & Format2(MMM_M1) & Space(16) & Format2(PP_M2)
Com(1) = MMM_M1 : Com(2) = MM_M1 : Com(3) = M_M1
Com(4) = M(1) : Com(5) = M(2) : Com(6) = P_M2 : Com(7) = PP_M2
End If
If C = P_M2 And Dist <> 30 Then
PP_M2 = Fuori90(P_M2 + Dist)
PPP_M2 = Fuori90(PP_M2 + Dist)
M_M1 = Fuori90((90 + M(1)) - Dist)
MM_M1 = Fuori90((90 + M_M1) - Dist)
S1 = S1 & Format2(M(1)) & " " & Format2(M(2)) & " " & Format2(P_M2)
S2 = S2 & Format2(M_M1) & Space(10) & Format2(PP_M2)
S3 = S3 & Format2(MM_M1) & Space(16) & Format2(PPP_M2)
Com(1) = MM_M1 : Com(2) = M_M1 : Com(3) = M(1)
Com(4) = M(2) : Com(5) = P_M2 : Com(6) = PP_M2 : Com(7) = PPP_M2
End If
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es - 1) & " del " & DataEstrazione(Es - 1)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es - 1,R1,P5)
If E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P4 = 1 To 5
E1 = Estratto(Es,R1,P4)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi " Condizione Sortita" & Space(9) & S1,1
Scrivi " Ambate Capogioco " & Space(6) & S2,1
Scrivi " Laterali di Proseg. " & S3,1
Scrivi
Scrivi " Completa" & Space(13) & StringaNumeri(Com," ",True),1,,,2
End If
End If
Next
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub
Sub Main
Dim ambata1(4),ambata2(4),ambo1(4),ambo2(4),calc(10)
Dim ruota(1),ruote(3),poste(2),posta(1)
posta(1) = 1
poste(2) = 1
'
rs = InputBox("Quante estrazioni vuoi controllare?",,0)
k = 0
For es = EstrazioneFin - rs To EstrazioneFin
AvanzamentoElab EstrazioneFin - rs,EstrazioneFin,es
For r = 1 To 10
'
For p1 = 1 To 4
For p2 = p1 + 1 To p2
'
a = Estratto(es,r,p1)
b = Estratto(es,r,p2)
c = Estratto(es - 1,r,p1)
d = Estratto(es - 1,r,p2)
'-------------------------------
x = Fuori90(a*2 - b)
y = Fuori90(b*2 - a)
'
z = Distanza(a,b)
'
If x = c Or y = d Then
'
If x = c Then
ambata1(1) = y
ruota(1) = r
End If
If y = d Then
ambata1(1) = x
ruota(1) = r
End If
'
If x = c Then
ambo1(1) = y
ambo1(2) = Diametrale(d)
ruote(1) = r
ruote(2) = TT_
ruote(3) = NZ_
End If
If y = d Then
ambo1(1) = x
ambo1(2) = Diametrale(c)
ruote(1) = r
ruote(2) = TT_
ruote(3) = NZ_
End If
'
'
calc(1) = a
calc(2) = b
calc(3) = c
calc(4) = d
'
ReDim MatriceCaselleDaEvid(5,1)
' 1
MatriceCaselleDaEvid(1,0) = r '
MatriceCaselleDaEvid(1,1) = 1 '
' 2
MatriceCaselleDaEvid(2,0) = r '
MatriceCaselleDaEvid(2,1) = 2 '
' 3
MatriceCaselleDaEvid(3,0) = r '
MatriceCaselleDaEvid(3,1) = 3 '
' 4
MatriceCaselleDaEvid(4,0) = r '
MatriceCaselleDaEvid(4,1) = 4 '
' 5
MatriceCaselleDaEvid(5,0) = r '
MatriceCaselleDaEvid(5,1) = 5 '
'
Call DisegnaEstrazione(es - 1,MatriceCaselleDaEvid)
ReDim MatriceCaselleDaEvid(5,1)
' 1
MatriceCaselleDaEvid(1,0) = r '
MatriceCaselleDaEvid(1,1) = 1 '
' 2
MatriceCaselleDaEvid(2,0) = r '
MatriceCaselleDaEvid(2,1) = 2 '
' 3
MatriceCaselleDaEvid(3,0) = r '
MatriceCaselleDaEvid(3,1) = 3 '
' 4
MatriceCaselleDaEvid(4,0) = r '
MatriceCaselleDaEvid(4,1) = 4 '
' 5
MatriceCaselleDaEvid(5,0) = r '
MatriceCaselleDaEvid(5,1) = 5 '
'
Call DisegnaEstrazione(es,MatriceCaselleDaEvid)
'
'
Scrivi DataEstrazione(es - 1,1) & " " & SiglaRuota(r) & " " & StringaEstratti(es - 1,r) & _
" numero " & Format2(c) & Space(1) & Format2(d) & "",1,1,7,3,4
Scrivi DataEstrazione(es,1) & " " & SiglaRuota(r) & " " & StringaEstratti(es,r) & _
" numero " & Format2(a) & Space(1) & Format2(b) & "",1,1,3,7,4
'
Scrivi
Scrivi("" & Format2(a) & "x2 - " & Format2(b) & " = "),1,0,1,5,3
Scrivi("" & Format2(x) & " * ") & " ",1,0,7,3,3
Scrivi
Scrivi("" & Format2(b) & "x2 - " & Format2(a) & " = "),1,0,1,5,3
Scrivi("" & Format2(y) & " * ") & " ",1,0,7,3,3
Scrivi
Scrivi
Scrivi("* Sequenza " & Format2(z) & " * ") & " ",1,0,7,3,3
Scrivi
'Call DisegnaCerchioCiclometrico(calc,True,True,,,True,True,True)
'
ImpostaGiocata 1,ambata1,ruota,posta,k,1
Scrivi
ImpostaGiocata 2,ambo1,ruote,poste,k,2
Gioca es,1,,1
Scrivi
'
End If
Next
Next
Next
Next
Scrivi "script di Zetrix",0,1,1,5,4,4,8
Scrivi "dinamica estratti su due estrazioni consecutive",0,1,1,5,4,4,8
End Sub
Ringrazio Salvo50 istruzione non valida questo il messaggio ImagingCiao a Tutti.
Silvix, Aldinobis, Rudivall, Serpico90, Imaging
GRAZIE
Per la distanza ho messo un inputbox, si può cambiare
Ecco lo script, salvo errori e dimenticanze
Codice:Dim Caso,Casi,R1,R2,P1,P2,P3,P4,P5 Dim E1,E2,S1,S2,S3,A,B,C,FIn,Es,Ini,Dist Dim M_M1,MM_M1,MMM_M1,P_M2,PP_M2,PPP_M2 Dim M(2),Com(7) FIn = EstrazioneFin Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,10110) Dist = CInt(InputBox("Inserisci la Distanza tra i due Estratti - MAX 45?",,26)) Scrivi Space(15) & " METODO DISTANZA " & Format2(Dist) & " POSTATO da IMAGING - Script Salvo50" & Space(15),1,,4,,3,,1 Call ScegliRange(Ini,FIn,Ini,FIn) For Es = Ini To FIn AvanzamentoElab Ini,FIn,Es Caso = 0 For R1 = 1 To 10 For P1 = 1 To 4 For P2 = P1 + 1 To 5 A = Estratto(Es,R1,P1) B = Estratto(Es,R1,P2) If Distanza(A,B) = Dist Then M(1) = A : M(2) = B OrdinaMatrice M,1 For P3 = 1 To 5 C = Estratto(Es - 1,R1,P3) If A <> C And B <> C Then M_M1 = Fuori90((90 + M(1)) - 26) P_M2 = Fuori90(M(2) + 26) S1 = "" S2 = "" S3 = "" If C = M_M1 Then MM_M1 = Fuori90((90 + C) - 26) MMM_M1 = Fuori90((90 + MM_M1) - 26) P_M2 = Fuori90(M(2) + 26) PP_M2 = Fuori90(P_M2 + 26) S1 = S1 & Format2(M_M1) & " " & Format2(M(1)) & " " & Format2(M(2)) S2 = S2 & Format2(MM_M1) & Space(10) & Format2(P_M2) S3 = S3 & Format2(MMM_M1) & Space(16) & Format2(PP_M2) Com(1) = MMM_M1 : Com(2) = MM_M1 : Com(3) = M_M1 Com(4) = M(1) : Com(5) = M(2) : Com(6) = P_M2 : Com(7) = PP_M2 Else If C = P_M2 Then PP_M2 = Fuori90(P_M2 + 26) PPP_M2 = Fuori90(PP_M2 + 26) M_M1 = Fuori90((90 + M(1)) - 26) MM_M1 = Fuori90((90 + M_M1) - 26) S1 = S1 & Format2(M(1)) & " " & Format2(M(2)) & " " & Format2(P_M2) S2 = S2 & Format2(M_M1) & Space(10) & Format2(PP_M2) S3 = S3 & Format2(MM_M1) & Space(16) & Format2(PPP_M2) Com(1) = MM_M1 : Com(2) = M_M1 : Com(3) = M(1) Com(4) = M(2) : Com(5) = P_M2 : Com(6) = PP_M2 : Com(7) = PPP_M2 Caso = Caso + 1 Casi = Casi + 1 ColoreTesto 1 Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000") ColoreTesto 2 Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000") ColoreTesto 0 Scrivi(" Estrazione n." & Format2(Es - 1) & " del " & DataEstrazione(Es - 1)),1,0 Scrivi " " & SiglaRuota(R1) & " ",1,0 For P5 = 1 To 5 E1 = Estratto(Es - 1,R1,P5) If E1 = C Then ColoreTesto 2 Else ColoreTesto 0 End If Scrivi Format2(E1) & " ",1,0 ColoreTesto 0 Next Scrivi Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0 Scrivi " " & SiglaRuota(R1) & " ",1,0 For P4 = 1 To 5 E1 = Estratto(Es,R1,P4) If E1 = A Or E1 = B Then ColoreTesto 2 Else ColoreTesto 0 End If Scrivi Format2(E1) & " ",1,0 ColoreTesto 0 Next Scrivi Scrivi Scrivi " Condizione Sortita" & Space(9) & S1,1 Scrivi " Ambate Capogioco " & Space(6) & S2,1 Scrivi " Laterali di Proseg. " & S3,1 Scrivi Scrivi " Completa" & Space(13) & StringaNumeri(Com," ",True),1,,,2 End If End If End If Next End If Next Next Next If ScriptInterrotto Then Exit Sub Next End Sub
Ottimo listato OK, estrazione consecutive, nella prima estrazione trovare un elemento o l'ambo o al contrario nella estrazione successiva l'ambo dist.26 o il terzo elemento (numero)...mi piace questo listato.....Codice:Sub Main Dim ambata1(4),ambata2(4),ambo1(4),ambo2(4),calc(10) Dim ruota(1),ruote(3),poste(2),posta(1) posta(1) = 1 poste(2) = 1 ' rs = InputBox("Quante estrazioni vuoi controllare?",,0) k = 0 For es = EstrazioneFin - rs To EstrazioneFin AvanzamentoElab EstrazioneFin - rs,EstrazioneFin,es For r = 1 To 10 ' For p1 = 1 To 4 For p2 = p1 + 1 To p2 ' a = Estratto(es,r,p1) b = Estratto(es,r,p2) c = Estratto(es - 1,r,p1) d = Estratto(es - 1,r,p2) '------------------------------- x = Fuori90(a*2 - b) y = Fuori90(b*2 - a) ' z = Distanza(a,b) ' If x = c Or y = d Then ' If x = c Then ambata1(1) = y ruota(1) = r End If If y = d Then ambata1(1) = x ruota(1) = r End If ' If x = c Then ambo1(1) = y ambo1(2) = Diametrale(d) ruote(1) = r ruote(2) = TT_ ruote(3) = NZ_ End If If y = d Then ambo1(1) = x ambo1(2) = Diametrale(c) ruote(1) = r ruote(2) = TT_ ruote(3) = NZ_ End If ' ' calc(1) = a calc(2) = b calc(3) = c calc(4) = d ' ReDim MatriceCaselleDaEvid(5,1) ' 1 MatriceCaselleDaEvid(1,0) = r ' MatriceCaselleDaEvid(1,1) = 1 ' ' 2 MatriceCaselleDaEvid(2,0) = r ' MatriceCaselleDaEvid(2,1) = 2 ' ' 3 MatriceCaselleDaEvid(3,0) = r ' MatriceCaselleDaEvid(3,1) = 3 ' ' 4 MatriceCaselleDaEvid(4,0) = r ' MatriceCaselleDaEvid(4,1) = 4 ' ' 5 MatriceCaselleDaEvid(5,0) = r ' MatriceCaselleDaEvid(5,1) = 5 ' ' Call DisegnaEstrazione(es - 1,MatriceCaselleDaEvid) ReDim MatriceCaselleDaEvid(5,1) ' 1 MatriceCaselleDaEvid(1,0) = r ' MatriceCaselleDaEvid(1,1) = 1 ' ' 2 MatriceCaselleDaEvid(2,0) = r ' MatriceCaselleDaEvid(2,1) = 2 ' ' 3 MatriceCaselleDaEvid(3,0) = r ' MatriceCaselleDaEvid(3,1) = 3 ' ' 4 MatriceCaselleDaEvid(4,0) = r ' MatriceCaselleDaEvid(4,1) = 4 ' ' 5 MatriceCaselleDaEvid(5,0) = r ' MatriceCaselleDaEvid(5,1) = 5 ' ' Call DisegnaEstrazione(es,MatriceCaselleDaEvid) ' ' Scrivi DataEstrazione(es - 1,1) & " " & SiglaRuota(r) & " " & StringaEstratti(es - 1,r) & _ " numero " & Format2(c) & Space(1) & Format2(d) & "",1,1,7,3,4 Scrivi DataEstrazione(es,1) & " " & SiglaRuota(r) & " " & StringaEstratti(es,r) & _ " numero " & Format2(a) & Space(1) & Format2(b) & "",1,1,3,7,4 ' Scrivi Scrivi("" & Format2(a) & "x2 - " & Format2(b) & " = "),1,0,1,5,3 Scrivi("" & Format2(x) & " * ") & " ",1,0,7,3,3 Scrivi Scrivi("" & Format2(b) & "x2 - " & Format2(a) & " = "),1,0,1,5,3 Scrivi("" & Format2(y) & " * ") & " ",1,0,7,3,3 Scrivi Scrivi Scrivi("* Sequenza " & Format2(z) & " * ") & " ",1,0,7,3,3 Scrivi 'Call DisegnaCerchioCiclometrico(calc,True,True,,,True,True,True) ' ImpostaGiocata 1,ambata1,ruota,posta,k,1 Scrivi ImpostaGiocata 2,ambo1,ruote,poste,k,2 Gioca es,1,,1 Scrivi ' End If Next Next Next Next Scrivi "script di Zetrix",0,1,1,5,4,4,8 Scrivi "dinamica estratti su due estrazioni consecutive",0,1,1,5,4,4,8 End Sub
IMAGING ho questo script sulle dinamiche estratti ma si deve modificare con la dist 26..
CiaoRingrazio Salvo50 istruzione non valida questo il messaggio Vedi l'allegato 2240469 Imaging
Ciao ImagingRingrazio Salvo50 istruzione non valida questo il messaggio Vedi l'allegato 2240469 Imaging
Ciao, Salvo50 non ho capito niente di quello che mi hai spiegato anche perché io di listati non ne capisco zero.....ho rilanciato il listato l'errore è sempre lo stesso.Ciao
Ciao Imaging
Non lo so perché ti da quell'errore, comunque lo script è da riprendere perché c'era un errore che mi selezionava solo gli estratti che erano maggiori del numero più alto, comunque se dovesse darti di nuovo quell'errore spunta pure la riga per il funzionamento del programma non serve, io la metto sempre in tutti i miei script perché se uno script ci mette troppo a finire pigiando il tasto stop fa finire il programma, senza quella riga o ti sorbisci tutto il programma quando dura, dura oppure Control Alt Cent
Per Tutti lo script del post 8 è da riprendere
Ho fatto copia e incolla dello script postato al post 8, cioè lo copiato dal post 8 e lo postato nel mio computer, è funziona, quindi non so cosa può essere, prova a ricaricarlo, bohCiao, Salvo50 non ho capito niente di quello che mi hai spiegato anche perché io di listati non ne capisco zero.....ho rilanciato il listato l'errore è sempre lo stesso.
Ciao, se vuoi te lo riscrivo......Imaging.Provo grande rispetto per chi è riuscito a leggere il metodo, i miei occhi si sono rifiutati.
Ciao a tutti i partecipanti.
Grazie , lo script di Salvo50 è ottimo un buon listato grazie della disponibilitàCiao imaging, non serve lo script l ha già fatto uno degli scripter più bravi
E più disponibili
Ottimo lavoro sempre Grazie per la disponibilità il listato è OKHo tolto Sub Main all'inizio e mi da lo stesso errore, quindi quando prendi lo script con copia, salti il pezzettino di sopra
prova e controlla che l'hai preso tutto lo script