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.
Evidenziare estratti Come fare
- Creatore Discussione Xeroxs
- Data di inizio
questo è lo script
il verifica esito è un po delicato perchè io lo avevo improntato per le terzine
quindi controlla in alcuni punti per le terzine e non per le quartine
ci sono 2 for next da modificare in 4 controlli e non in 3 controlli
inoltre è in parte preparato per emettere il form di riepilogo in sovrapposizione
ma che per il momento non te lo messo
il verifica esito è un po delicato perchè io lo avevo improntato per le terzine
quindi controlla in alcuni punti per le terzine e non per le quartine
ci sono 2 for next da modificare in 4 controlli e non in 3 controlli
inoltre è in parte preparato per emettere il form di riepilogo in sovrapposizione
ma che per il momento non te lo messo
Codice:
Option Explicit
' Ricerca la Somma Scelta di Quattro Estratti
Sub Main
Dim Ruota,IniCol,FinCol
Dim Rig,Co1
Dim Co2,Co3,Co4,colx
Dim a,b,c,d,e,nTSomma,aa
Dim posit,negat,es,casi
nTSomma = CInt(InputBox("Inserisci una Somma da 1 a 90","Ricerca Somma",90))
For Rig = 1 To righe
If GetValue(Rig,0) = "00" Then
Exit For
End If
es = Rig
posit = 0
negat = 0
ReDim colpo(13)
For Ruota = 1 To 11
FinCol = Ruota*5
IniCol = FinCol - 4
' ReDim aN(90)
For Co1 = IniCol To FinCol - 3
a = GetValueInt(Rig,Co1)
For Co2 = Co1 + 1 To FinCol - 2
b = GetValueInt(Rig,Co2) 'as Long [Ottiene il valore di una cella espresso come numero intero]
For Co3 = Co2 + 1 To FinCol - 1
c = GetValueInt(Rig,Co3)
For Co4 = Co3 + 1 To FinCol
d = GetValueInt(Rig,Co4)
If a + b + c + d = nTSomma Then
ReDim anum(4),an(90)
an(a) = 1
an(b) = 1
an(c) = 1
an(d) = 1
anum(1) = a
anum(2) = b
anum(3) = c
anum(4) = d
'''Evidenzia Numeri a video
For colx = IniCol To FinCol
aa = getValueint(Rig,colx)
If an(aa) = 1 Then
Call setCerchio(Rig,colx,RGB(250,153,88),,vbBlack)
End If
Next
'''verifica esito
If an(a) = 1 And an(b) = 1 And an(c) = 1 And an(d) = 1 Then
'''prova verifica esito
Call VerificaEsito(es,anum,Ruota,Rig,posit,negat,colpo)
End If
End If
Next
Next
Next
Next
Next
Next
End Sub
Function VerificaEsito(es,aNum,Ruota,Rig,posit,negat,colpo)
Dim rigcol,k,nu,w,lastestr,FincolV,IniColV,positivo,negativo,cc,ss
FincolV = Ruota*5
IniColV = FincolV - 4
rigcol = Rig
lastestr = Rig + 13
positivo = 0
negativo = 0
cc = 0
'''verifica per 13 colpi
For rigcol = rigcol + 1 To lastestr
cc = cc + 1
'''fine file exit
If GetValue(rigcol,0) = "00" Then
Exit For
End If
'''controlla se presente 1 della terzina per 5 posizioni
For w = 1 To 4
For k = 0 To 4
If aNum(w) > 0 Then
If GetValueInt(rigcol,IniColV + k) = Int(aNum(w)) Then
Call setCerchio(rigcol,IniColV + k,vbBlack)
positivo = positivo + 1
colpo(cc) = colpo(cc) + 1
End If
End If
Next
Next
Next
If positivo > 0 Then
posit = posit + positivo
Else
negat = negat + 1
''
rigcol = es
For w = 1 To 4
For k = 0 To 4
If aNum(w) > 0 Then
If GetValueInt(rigcol,IniColV + k) = Int(aNum(w)) Then
Call setCerchio(rigcol,IniColV + k,vbYellow,,vbBlack)
End If
End If
Next
Next
''
End If
End Function
Ad Esempio questo è quello che avevo corretto, ho notato che Tu usi la terzina di somma classica io ho creato il terno completo
Codice:
Option Explicit
' Ricerca la Somma Scelta di tre Estratti = Terno di Somma della Terzina
Sub Main
Dim Ruota,IniCo1,FinCo1
Dim Rig,Co1
Dim Co2,Co3
Dim a,b,c,d,e,nTSomma
nTSomma = cint(InputBox("Inserisci una Somma da 1 a 90","Ricerca Somma",90))
For Rig = 1 To righe
If GetValue(Rig,0) = "00" Then
Exit For
End If
For Ruota = 1 To 11
FinCo1 = Ruota*5
IniCo1 = FinCo1 - 4
ReDim aN(90)
For Co1 = IniCo1 To FinCo1 - 2
a = GetValueInt(Rig,Co1)
For Co2 = Co1 + 1 To FinCo1 - 1
b = GetValueInt(Rig,Co2) 'as Long [Ottiene il valore di una cella espresso come numero intero]
For Co3 = Co2 + 1 To FinCo1
c = GetValueInt(Rig,Co3)
If Somma(a,b,c) = nTSomma Then aN(a) = 1 : aN(b) = 1 : aN(c) = 1
Next
Next
Next
For Co1 = IniCo1 To FinCo1
a = getValueint(Rig,Co1)
If aN(a) = 1 Then
Call setCerchio(Rig,Co1)
End If
Next
Next
Next
End Sub
' Funzione Per il Terno Di Somma
Function Somma(a,b,c)
Dim nTSomma
nTSomma = (a + b + c)
Do While nTSomma > 90
nTSomma = 90 - nTSomma
Loop
Somma = nTSomma
End Function
le terzine basta togliere un for next
correggere da -4 -3 -2 -1 a -3 -2 -1
perchè deve girare non 5 volte ma 10 volte quanti sono i terni in una cinquina
modificare gli elementi che aNum contiene sono 3 e non come prima erano 4
nel verifica esito i for next che devono girare 3 volte perchè stiamo esaminando
le terzine.
questa routine del verifica esito è da renderla generica cos' che non si debba modificare o ricordarsi
ad ogni volta che si usa.
correggere da -4 -3 -2 -1 a -3 -2 -1
perchè deve girare non 5 volte ma 10 volte quanti sono i terni in una cinquina
modificare gli elementi che aNum contiene sono 3 e non come prima erano 4
nel verifica esito i for next che devono girare 3 volte perchè stiamo esaminando
le terzine.
questa routine del verifica esito è da renderla generica cos' che non si debba modificare o ricordarsi
ad ogni volta che si usa.
Codice:
Option Explicit
' Ricerca la Somma Scelta di Quattro Estratti
Sub Main
Dim Ruota,IniCol,FinCol
Dim Rig,Co1
Dim Co2,Co3,Co4,colx
Dim a,b,c,d,e,nTSomma,aa
Dim posit,negat,es,casi
nTSomma = CInt(InputBox("Inserisci una Somma da 1 a 90","Ricerca Somma",90))
For Rig = 1 To righe
If GetValue(Rig,0) = "00" Then
Exit For
End If
es = Rig
posit = 0
negat = 0
ReDim colpo(13)
For Ruota = 1 To 11
FinCol = Ruota*5
IniCol = FinCol - 4
' ReDim aN(90)
For Co1 = IniCol To FinCol - 2
a = GetValueInt(Rig,Co1)
For Co2 = Co1 + 1 To FinCol - 1
b = GetValueInt(Rig,Co2)
For Co3 = Co2 + 1 To FinCol
c = GetValueInt(Rig,Co3)
If a + b + c = nTSomma Then
ReDim anum(3),an(90)
an(a) = 1
an(b) = 1
an(c) = 1
anum(1) = a
anum(2) = b
anum(3) = c
'''Evidenzia Numeri a video
For colx = IniCol To FinCol
aa = getValueint(Rig,colx)
If an(aa) = 1 Then
Call setCerchio(Rig,colx,RGB(250,153,88),,vbBlack)
End If
Next
'''verifica esito
If an(a) = 1 And an(b) = 1 And an(c) = 1 Then
'''prova verifica esito
Call VerificaEsito(es,anum,Ruota,Rig,posit,negat,colpo)
End If
End If
Next
Next
Next
Next
Next
End Sub
Function VerificaEsito(es,aNum,Ruota,Rig,posit,negat,colpo)
Dim rigcol,k,nu,w,lastestr,FincolV,IniColV,positivo,negativo,cc,ss
FincolV = Ruota*5
IniColV = FincolV - 4
rigcol = Rig
lastestr = Rig + 13
positivo = 0
negativo = 0
cc = 0
'''verifica per 13 colpi
For rigcol = rigcol + 1 To lastestr
cc = cc + 1
'''fine file exit
If GetValue(rigcol,0) = "00" Then
Exit For
End If
'''controlla se presente 1 della terzina per 5 posizioni
For w = 1 To 3
For k = 0 To 4
If aNum(w) > 0 Then
If GetValueInt(rigcol,IniColV + k) = Int(aNum(w)) Then
Call setCerchio(rigcol,IniColV + k,vbBlack)
positivo = positivo + 1
colpo(cc) = colpo(cc) + 1
End If
End If
Next
Next
Next
If positivo > 0 Then
posit = posit + positivo
Else
negat = negat + 1
''
rigcol = es
For w = 1 To 3
For k = 0 To 4
If aNum(w) > 0 Then
If GetValueInt(rigcol,IniColV + k) = Int(aNum(w)) Then
Call setCerchio(rigcol,IniColV + k,vbYellow,,vbBlack)
End If
End If
Next
Next
''
End If
End Function
Si lo avevo compreso,.
ed è fatto molto bene anche nel costrutto direi e confermo che mi sei di enorme aiuto e ripeto mai sottovalutarsi, possiamo anche non riuscire sempre nelle cose parlo per me ma ci provo e non amo arrendermi, certo ho bisogno come in questo caso di qualche aiuto...
ed è fatto molto bene anche nel costrutto direi e confermo che mi sei di enorme aiuto e ripeto mai sottovalutarsi, possiamo anche non riuscire sempre nelle cose parlo per me ma ci provo e non amo arrendermi, certo ho bisogno come in questo caso di qualche aiuto...
quando si lancia uno script che contiene una inputbox
la griglia si evidenziano i numeri richiesti, ma se continuo al giro successivo sempre con il medesimo script
ma condizione inputbox diversa rimangono accesi tutti i numeri precedenti e quelli dell'ultima richiesta
perche perdano la loro evidenza colore, bisogna uscire dallo script e rientrare.
all'inizio dello script cosa si può usare per spegnere per così dire il colore dei precedenti?
la griglia si evidenziano i numeri richiesti, ma se continuo al giro successivo sempre con il medesimo script
ma condizione inputbox diversa rimangono accesi tutti i numeri precedenti e quelli dell'ultima richiesta
perche perdano la loro evidenza colore, bisogna uscire dallo script e rientrare.
all'inizio dello script cosa si può usare per spegnere per così dire il colore dei precedenti?
L
LuigiB
Guest
niente la griglia si ridisegna appena si cambia estrazione ..
L
LuigiB
Guest
posso farla ridisegnare se uno cambia script
L
LuigiB
Guest
no gia fa cosi ... dovrei mettere una funzione per pulire la griglia da script ...
i legend
Premium Member
56 in posEsempio di utility
senza nessuna pretesa
in verde sono evidenziate le frequenze a tre in rosso a 2 e in nero a freq singola
salta agli occhi la semplicissima struttura
non è detto che paghi , infatti serve solo esempio per aiutare gli occhi a trovare qualcosina
nel disegno le spiegazioni
Vedi l'allegato 2212235
da verificare in 9 estrazioni gli estratti 56.71 in 2.3.4. posizione sulla nazionale
ambo secco Nazionale e anche a tutte
56 estratto primario 71 recupero
lunghetta 56.64.71.90
NESSUNA GARANZIA DI VINCITA
ciao
Buongiorno a Tutti.
Ciao LuigiB
Volevo ChiedetTi sempre se lo Ritieni Utile/necessario senza nulla pretendere come ho sempre fatto in questo Forum alcuni aggiornamenti per LottoOpen
Nel Continuare Il Mio Test sul Programma Versione 1.0.56:
- Elenco Estrazioni
Si Potrebbe Allungare la Barra dove Seleziono lo Script a Volte se salvo dei Test ripetuti non vedo
se ho scelto quello giusto, qualche cm può essere utile (Penso)
- Seleziona Combinazioni da Evidenziare o Meglio
Volevo ChiederTi se possibile creare un secondo "Mini" Evidenziatore Numeri Tipo quello di Spaziometria
indipendente dall'altro che attiva/disattiva nell'immediato il/i numeri selezionati nel quadro
Elenco Estrazioni così da avere sempre nell'immediato con lo script che magari ho lanciato che mi evidenzia dei numeri scelti
e con quelli che io evidenzio con il mini Evidenziatore ho un riscontro Visivo per creare metodi o scelte future.
Credo che possa avere dimensioni contenute senza salvare preselezioni o altro proprio un "Mini"
- Statistica (Forse)
Non So se Lo ritieni Utile per migliorare il programma e completare una Statistica flessibile
Penso che potrebbe essere Utile una tabella riassuntiva dei Ritardi di ogni Ruota tipo quella
che ho visto anche nel Sito di Lottoced a questo Link
https://www.lottoced.com/lotto/ritardi-top-15/?refresh_cens
Li sono esposti 15 numeri ma credo ne bastino 5 Con i loro Rispettivi ritardi per trovare convergenze
da usare o scartare la chicca potrebbe essere quella di Evidenziare i numeri presenti più volte
proprio per fare la scelta migliore magari con ambate ricavate da Metodi o Statistiche di varia Natura.
Grazie Come Sempre
Ciao LuigiB
Volevo ChiedetTi sempre se lo Ritieni Utile/necessario senza nulla pretendere come ho sempre fatto in questo Forum alcuni aggiornamenti per LottoOpen
Nel Continuare Il Mio Test sul Programma Versione 1.0.56:
- Elenco Estrazioni
Si Potrebbe Allungare la Barra dove Seleziono lo Script a Volte se salvo dei Test ripetuti non vedo
se ho scelto quello giusto, qualche cm può essere utile (Penso)
- Seleziona Combinazioni da Evidenziare o Meglio
Volevo ChiederTi se possibile creare un secondo "Mini" Evidenziatore Numeri Tipo quello di Spaziometria
indipendente dall'altro che attiva/disattiva nell'immediato il/i numeri selezionati nel quadro
Elenco Estrazioni così da avere sempre nell'immediato con lo script che magari ho lanciato che mi evidenzia dei numeri scelti
e con quelli che io evidenzio con il mini Evidenziatore ho un riscontro Visivo per creare metodi o scelte future.
Credo che possa avere dimensioni contenute senza salvare preselezioni o altro proprio un "Mini"
- Statistica (Forse)
Non So se Lo ritieni Utile per migliorare il programma e completare una Statistica flessibile
Penso che potrebbe essere Utile una tabella riassuntiva dei Ritardi di ogni Ruota tipo quella
che ho visto anche nel Sito di Lottoced a questo Link
https://www.lottoced.com/lotto/ritardi-top-15/?refresh_cens
Li sono esposti 15 numeri ma credo ne bastino 5 Con i loro Rispettivi ritardi per trovare convergenze
da usare o scartare la chicca potrebbe essere quella di Evidenziare i numeri presenti più volte
proprio per fare la scelta migliore magari con ambate ricavate da Metodi o Statistiche di varia Natura.
Grazie Come Sempre
Ciao a Tutti,
Ho Creato questo Script che dovrebbe evidenziare dei Numeri scelti ( 3 nel mio caso) è questo lo fa,
Avrei però bisogno di capire come intervenire per far si chè evidenzi solo l'ambo o il terno se capita ma con i miei tentativi o modi di fare non ci riesco qualcuno può aiutarmi.
Grazie come sempre
Ho Creato questo Script che dovrebbe evidenziare dei Numeri scelti ( 3 nel mio caso) è questo lo fa,
Avrei però bisogno di capire come intervenire per far si chè evidenzi solo l'ambo o il terno se capita ma con i miei tentativi o modi di fare non ci riesco qualcuno può aiutarmi.
Grazie come sempre
Codice:
Option Explicit
' Evidenzia Ambo Spia Scelto Dall'Utente
Sub Main
Dim Ruota,IniCo1,FinCo1
Dim Rig,Co1
Dim Co2,Co3
Dim nSomma
Dim a,b,c
Dim aNum1,aNum2,aNum3 ' Numeri Scelti Dall'Utente
'aNum1 = cint(InputBox("Inserisci il Primo Numero da 1 a 90","Numero",90))
'aNum2 = cint(InputBox("Inserisci il Secondo Numero da 1 a 90","Numero",90))
'aNum3 = cint(InputBox("Inserisci il Terzo Numero da 1 a 90","Numero",90))
'**** Se Vuoi Inserire i Numeri nello Script ***
aNum1 = 1
aNum2 = 10
aNum3 = 79
For Rig = 1 To righe
If GetValue(Rig,0) = "00" Then
Exit For
End If
For Ruota = 1 To 11
FinCo1 = Ruota*5
IniCo1 = FinCo1 - 4
ReDim aN(90)
For Co1 = IniCo1 To FinCo1 - 1
a = GetValueInt(Rig,Co1)
For Co2 = Co1 + 1 To FinCo1
b = GetValueInt(Rig,Co2) 'as Long [Ottiene il valore di una cella espresso come numero intero]
For Co3 = Co2 + 1 To FinCo1
c = GetValueInt(Rig,Co3)
If a = aNum1 Or a = aNum2 Or a = aNum3 Then aN(a) = 1
If b = aNum1 Or b = aNum2 Or b = aNum3 Then aN(b) = 1
If c = aNum1 Or c = aNum2 Or c = aNum3 Then aN(c) = 1
'Altri Miei Tentativi
'If a = aNum1 Or a = aNum2 Or a = aNum3 And Not a = aNum2 And Not a = aNum3 Then aN(a) = 1
'If b = aNum1 Or b = aNum2 Or b = aNum3 Then aN(b) = 1
'If c = aNum1 Or c = aNum2 Or c = aNum3 Then aN(c) = 1
Next
Next
Next
For Co1 = IniCo1 To FinCo1
a = getValueint(Rig,Co1)
If aN(a) = 1 Then
Call setCerchio(Rig,Co1)
End If
Next
Next ' Chiude Ruota
Next ' Chiude Rig
End SubUltima estrazione Lotto
-
Estrazione del lotto
sabato 11 gennaio 2025Bari7343015881Cagliari6960180210Firenze2532185554Genova4805403469Milano1007704479Napoli1189013480Palermo3780824477Roma7804383956Torino0813302724Venezia5675361870Nazionale6383193180Estrazione Simbolotto
Bari
3534122320
