Novità

Fosse possibile realizzarlo credo che sarebbe molto utile...

lotto_tom75

Advanced Premium Member
Fosse possibile realizzarlo credo che sarebbe molto utile... x verificare tutti gli eventuali esiti nel modo più rapido e pratico possibile...

Uno script che verifichi se è uscito qualche numero su una o piu' ruote o tutte una volta copiato e incollato da tabella colorata il gruppo numerico voluto.

Qualcuno/a sarebbe in grado di realizzarlo? Io purtroppo no :( :rolleyes:

Resto disponibile per ulteriori eventuali chiarimenti al riguardo :)

Es.attuativo

Copio e incollo nella tabella colorata di immisione valori dello script il seguente gruppo numerico d'interesse 10.71.80.75.2.90.88.32.76.13.84.23

poi clicco su verifica... e lo script mi dice se è uscito qualcosa.. e magari anche cosa e dove su ruota unica, tutte e/o nazionale :D

Secondo voi sarebbe utile uno script del genere? ;)
 
Ultima modifica:
Cioe uno script che prende dei numeri e li vetifica dappertutto...non e difficile fsre una cosa simile ....non voglio dire che lo faccio io attenzione....
 
Si Tom lo faccio io.

Prendi un qualsiasi file di txt incollalo sul box di richiesta(avendo cura di splittare il carattere separatore) e verificane le risultanze


Codice:
Sub Main()

Dim numero(10),ruota(1),sorte

sorte = CInt(InputBox("Quale sorte verificare ",,1))

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

ii = InputBox("DIGITA NUMERI SEPARATI DA VIRGOLA ",,"1.2.3.4,5.6")

ReDim num(0)

Call SplitByChar(ii,".",num) ' split carattere separatore

'---------------------------------------------------------------------------

nStart = Timer ' partenza tempo di elaborazione

'ScegliNumeri(num)

Ini = EstrazioneIni

fin = EstrazioneFin

diff = fin - Ini + 1

Scrivi"Statistica Veloce su combinazione di Numeri scelti" & " ",True,False,6,0,3

Scrivi" " & StringaNumeri(num) & " ",True,False,2,4,3

Scrivi" Per sorte..." & " " & NomeSorte(sorte) & " ",True,True,3,0,3

Scrivi String(130,"=")

Scrivi " Dalla data..." & DataEstrazione(Ini) & " alla data..." & DataEstrazione(fin) & " - Estrazioni Totali " & DIFF,1

Scrivi String(130,"=")

Scrivi

'--------- crea tabella---------------

ReDim atitoli(14)

atitoli(1) = " Ruota "

'atitoli(2) = " Combinazione "

atitoli(3) = " RD1 "

atitoli(4) = " RD2 "

atitoli(5) = " RD3 "

atitoli(6) = " RD4 "

atitoli(7) = " RD5 "

atitoli(8) = " Ritardo attuale "

atitoli(9) = " Ritardo Storico "

atitoli(10) = " incr. storico "

atitoli(11) = " Frequenza "

atitoli(12) = " - esito - "

atitoli(13) = " - stringa Esito - "

atitoli(14) = " data estraz.uscita "

' inizializzo la tabella

Call InitTabella(atitoli,1,,3,5)

For r = 1 To 12

'If r = 11 Then r = 12

ruota(1) = r

Call AvanzamentoElab(Ini,fin,n)

If ScriptInterrotto Then Exit For

Call StatisticaFormazione(num,ruota,sorte,rit,ritmax,incrRitMax,freq,Ini,fine)

Call VerificaEsito(num,ruota,fin - rit,sorte,1,,retesito,retcolpi,retestratti,retidestr)

'----- calcolo valori in tabella --------------

ReDim avalori(14)

avalori(1) = NomeRuota(r)

avalori(3) = RitDiPos(num,1,ruota)

avalori(4) = RitDiPos(num,2,ruota)

avalori(5) = RitDiPos(num,3,ruota)

avalori(6) = RitDiPos(num,4,ruota)

avalori(7) = RitDiPos(num,5,ruota)

avalori(8) = rit

avalori(9) = ritmax

avalori(10) = incrRitMax

avalori(11) = freq

avalori(12) = retesito

avalori(13) = retestratti

If retesito <> "" Then avalori(14) = DataEstrazione(retidestr)

If retesito = "" Then avalori(14) = " -- "

Call AddRigaTabella(avalori,,,3,,"arial black")

If r = 11 Then Call SetColoreCella(11,3,1)

Next

Call SetTableWidth("100%")

'Call CreaTabella()

scegliTabella

Scrivi " Script By Mike58 ",1,- 1,6

nend = Timer

Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))

End Sub

Function RitDiPos(num,pos,ruota)

ReDim apos(5)

ReDim aruota(1)

ReDim anum(1)

anum(1) = num

apos(pos) = True

aruota(1) = ruota

RitDiPos = RitardoCombinazione(ruota,num,1,0,apos)

End Function

Function scegliTabella()

ReDim Voci(2)

Voci(1) = "Tabella Normale"

Voci(2) = "tabella Ordinabile"

scegliTabella = ScegliOpzioneMenu(Voci,01,"seleziona tabella")

If scegliTabella = 1 Then Call CreaTabella()

If scegliTabella = 2 Then Call CreaTabellaOrdinabile

End Function

Function FormattaSecondi(s)

'Questa Function trasforma il numero di secondi passato come parametro in una stringa

' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss

' s ---> Numero di secondi da formattare

' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )

Dim hh

Dim Mm

Dim Ss

Dim TimeStr

hh = s \ 3600

Mm =(s Mod 3600) \ 60

Ss = s -((hh * 3600) +(Mm * 60))

TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)

FormattaSecondi = TimeStr

End Function
 
Mike58;n1912976 ha scritto:
Si Tom lo faccio io.

Prendi un qualsiasi file di txt incollalo sul box di richiesta(avendo cura di splittare il carattere separatore) e verificane le risultanze


Codice:
Sub Main()

Dim numero(10),ruota(1),sorte

sorte = CInt(InputBox("Quale sorte verificare ",,1))

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

ii = InputBox("DIGITA NUMERI SEPARATI DA VIRGOLA ",,"1.2.3.4,5.6")

ReDim num(0)

Call SplitByChar(ii,".",num) ' split carattere separatore

'---------------------------------------------------------------------------

nStart = Timer ' partenza tempo di elaborazione

'ScegliNumeri(num)

Ini = EstrazioneIni

fin = EstrazioneFin

diff = fin - Ini + 1

Scrivi"Statistica Veloce su combinazione di Numeri scelti" & " ",True,False,6,0,3

Scrivi" " & StringaNumeri(num) & " ",True,False,2,4,3

Scrivi" Per sorte..." & " " & NomeSorte(sorte) & " ",True,True,3,0,3

Scrivi String(130,"=")

Scrivi " Dalla data..." & DataEstrazione(Ini) & " alla data..." & DataEstrazione(fin) & " - Estrazioni Totali " & DIFF,1

Scrivi String(130,"=")

Scrivi

'--------- crea tabella---------------

ReDim atitoli(14)

atitoli(1) = " Ruota "

'atitoli(2) = " Combinazione "

atitoli(3) = " RD1 "

atitoli(4) = " RD2 "

atitoli(5) = " RD3 "

atitoli(6) = " RD4 "

atitoli(7) = " RD5 "

atitoli(8) = " Ritardo attuale "

atitoli(9) = " Ritardo Storico "

atitoli(10) = " incr. storico "

atitoli(11) = " Frequenza "

atitoli(12) = " - esito - "

atitoli(13) = " - stringa Esito - "

atitoli(14) = " data estraz.uscita "

' inizializzo la tabella

Call InitTabella(atitoli,1,,3,5)

For r = 1 To 12

'If r = 11 Then r = 12

ruota(1) = r

Call AvanzamentoElab(Ini,fin,n)

If ScriptInterrotto Then Exit For

Call StatisticaFormazione(num,ruota,sorte,rit,ritmax,incrRitMax,freq,Ini,fine)

Call VerificaEsito(num,ruota,fin - rit,sorte,1,,retesito,retcolpi,retestratti,retidestr)

'----- calcolo valori in tabella --------------

ReDim avalori(14)

avalori(1) = NomeRuota(r)

avalori(3) = RitDiPos(num,1,ruota)

avalori(4) = RitDiPos(num,2,ruota)

avalori(5) = RitDiPos(num,3,ruota)

avalori(6) = RitDiPos(num,4,ruota)

avalori(7) = RitDiPos(num,5,ruota)

avalori(8) = rit

avalori(9) = ritmax

avalori(10) = incrRitMax

avalori(11) = freq

avalori(12) = retesito

avalori(13) = retestratti

If retesito <> "" Then avalori(14) = DataEstrazione(retidestr)

If retesito = "" Then avalori(14) = " -- "

Call AddRigaTabella(avalori,,,3,,"arial black")

If r = 11 Then Call SetColoreCella(11,3,1)

Next

Call SetTableWidth("100%")

'Call CreaTabella()

scegliTabella

Scrivi " Script By Mike58 ",1,- 1,6

nend = Timer

Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))

End Sub

Function RitDiPos(num,pos,ruota)

ReDim apos(5)

ReDim aruota(1)

ReDim anum(1)

anum(1) = num

apos(pos) = True

aruota(1) = ruota

RitDiPos = RitardoCombinazione(ruota,num,1,0,apos)

End Function

Function scegliTabella()

ReDim Voci(2)

Voci(1) = "Tabella Normale"

Voci(2) = "tabella Ordinabile"

scegliTabella = ScegliOpzioneMenu(Voci,01,"seleziona tabella")

If scegliTabella = 1 Then Call CreaTabella()

If scegliTabella = 2 Then Call CreaTabellaOrdinabile

End Function

Function FormattaSecondi(s)

'Questa Function trasforma il numero di secondi passato come parametro in una stringa

' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss

' s ---> Numero di secondi da formattare

' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )

Dim hh

Dim Mm

Dim Ss

Dim TimeStr

hh = s \ 3600

Mm =(s Mod 3600) \ 60

Ss = s -((hh * 3600) +(Mm * 60))

TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)

FormattaSecondi = TimeStr

End Function


Grazie mille mike, per adesso questo tuo fantastico script mi va più che bene ;) Poi eventualmente cercherò di implementarci il rilevamento del gruppo numerico da tabella e/o da file txt esterno. Grazie ancora grandissimo ;)
 
Ciao Tom, secondo me sei un po' lontano se cerchi di modificare questo script per avere delle risultanze da un file di testo.

2 sono i punti o crei uno script con un array sistemi preimpostato o importi direttamente un file di testo.

Se serve vedrò di darti una mano e magari posti il file di testo e tutte le specifiche che vuoi vedere analizzate.

Ciao, purtroppo come vedi Luigi è impegnato in altro e quindi lasciamolo lavorare.

Io d'altro canto aiuto e metto a disposizione per quello che posso.
 
Mike58;n1913033 ha scritto:
Ciao Tom, secondo me sei un po' lontano se cerchi di modificare questo script per avere delle risultanze da un file di testo.

2 sono i punti o crei uno script con un array sistemi preimpostato o importi direttamente un file di testo.

Se serve vedrò di darti una mano e magari posti il file di testo e tutte le specifiche che vuoi vedere analizzate.

Ciao, purtroppo come vedi Luigi è impegnato in altro e quindi lasciamolo lavorare.

Io d'altro canto aiuto e metto a disposizione per quello che posso.


Ciao mitico mike :) , ho visto solo adesso che aveva risposto anche il Maestro, che saluto e che ringrazio per il suo apporto anche in questo thread! ;) GRAZIE Luigi. E' logico.. se dovesse stare dietro a tutte le richieste che gli facciamo fra tutti/e per potenziare il suo magnifico software dovrebbe avere un sacco di braccia come la Dea Kalì o come si chiama :D . Meno male che ci sono fior fiori di suoi alllievi che come te mike58 o ancora i legend ecc... quasi lo raggiungono... in fatto di destrezza, bravura, umiltà, generosità e capacità di programmazione del suo fantastico linguaggio di scripting! :p Grazie ancora Mike58 per la tua esperienza, disponibilità, e bravura che condividi con passione con tutti/e noi. Ciao!
 
Ultima modifica:
Ciao Tom, gentilissimo anche tu, per gli aiuti script si utilizza la capacità ed il tempo a disposizione e non sempre si arriva alla Meta.
Ma come dico sempre provarci è sempre una buona palestra.

Comunque se hai bisogno posta una sorte di bloccoNote con le combinazioni anche ad esempio che vuoi analizzare e con quello che vuoi vedere e vediamo cosa possiamo fare.

Ciao
 
Mike58;n1913188 ha scritto:
Ciao Tom, gentilissimo anche tu, per gli aiuti script si utilizza la capacità ed il tempo a disposizione e non sempre si arriva alla Meta.
Ma come dico sempre provarci è sempre una buona palestra.

Comunque se hai bisogno posta una sorte di bloccoNote con le combinazioni anche ad esempio che vuoi analizzare e con quello che vuoi vedere e vediamo cosa possiamo fare.

Ciao


esempio di contenuto su file txt da analizzare con script di Mike58 x verificare eventuali esiti su tutte e/o su unica ruota

Es. di righe del tutto fittizie... (le lunghette sotto riportate sono solo a scopo di esempio e non sono assolutamente "ragionate" bensì totalmente a caso e quindi "non giocabili")


tipo 1 con lunghezza righe variabile (da 1 a 89 elementi :-))

17,30,
30,63,90,21,15,17
53,20,11,13,14,19,33,
17,45,72,
72,53,15,90,88,1,22
71,55,10,90,86,10,21,17,80,88,89,2

tipo 2 con lunghezza elementi fissa (es. 10 elementi per ciascuna riga)


01.02.03.04.05.06.08.09.13.14
01.02.05.21.27.42.53.63.67.70
01.05.15.19.20.38.39.59.62.72
01.05.16.32.40.44.45.48.64.74


ovviamente decidi tu caro Mike sia il segno separatore che il fatto di doverlo mettere a fine riga o meno e anche se sia possibile o meno fare entrambi i tipi di verifiche (tipo 1 e tipo 2 sopra riportati)
o solo uno di questi o nessuno... e anche se sia necessario avere delle righe ordinate o meno ;) ps: Negli esempi ti ho messo volutamente delle righe casuali non ordinate, xche' sarebbe il tipo di contenuto migliore per il file txt da verificare.


GRAZIE 1000 ancora amico. Ciao
 
Ultima modifica:
Ciao Tom, arrivo adesso dal lavoro, eleggo adesso.

Ti Posso dire che gli script si possono fare per entrambe le tipologie, solo dammi il tempo per la concentrazione ed il tempo necessario.

Ti faccio sapere al più presto
 
Ciao Tom, purtroppo il lavoro incombe e tempo a disposizione poco.

Come ti dicevo è possibile fare l'analisi nelle 2 forme

1° script permette di inserire le righe che credi in un array e verificarne la statistica voluta.

Codice:
Sub Main

Dim cmb(10)' aumentare il contatore pari al numero di combinazioni da cercare

Dim Ru(1)

Dim k,es

Dim nu

'qm = CInt(InputBox("Quale mese vuoi considerare ",,1))

ReDim aruote(12)

Scrivi " Ruota di... ",1,0,4

If ScegliRuote(aruote) > 0 Then

For k = 1 To UBound(aruote)

If aruote(k) > 0 Then

Scrivi " " & NomeRuota(aruote(k)),1,0,3

End If

Next

End If

Fin = EstrazioneFin

Ini = EstrazioneIni '8643'

Scrivi NomeRuota(Ru(1)),1,0

Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)

Scrivi

ReDim atitoli(19)

atitoli(1) = " N. CMB "

atitoli(2) = " Combinazione "

atitoli(3) = " Freq x 2 "

atitoli(4) = " Freq x 3 "

atitoli(5) = " Freq x 4 "

atitoli(6) = " Freq x 5 "

atitoli(7) = " Rit x 2 "

atitoli(8) = " Rit x 3 "

atitoli(9) = " Rit x 4 "

atitoli(10) = " Ritx 5"

atitoli(11) = " St.x 2 "

atitoli(12) = " st.x 3 "

atitoli(13) = " st.x 4 "

atitoli(14) = " st.x 5 "

atitoli(15) = " Esito "

atitoli(16) = " Stringa estratti "

atitoli(17) = " data esito "

atitoli(18) = " mese "

atitoli(19) = " Giorno "

Call InitTabella(atitoli,1,,3,5)

'-------------inserimento combinazioni --------------------------

cmb(1) = "33-02-03-61-62"

cmb(2) = "33-02"

cmb(3) = "33-03"

cmb(4) = "33-04"

cmb(5) = "61-62"

cmb(6) = "71-73-74-75"

cmb(7) = "61-62-83-84"

cmb(8) = "81-34-66-90"

cmb(9) = "16-45-67-89"

cmb(10) = "23-32-43-76"

'----------------- fine combinazioni ------------------------------

For N = 1 To UBound(cmb)

nu =(Split("0-" &(cmb(N)),"-"))

'For es = Ini To fin

'If Mese(es) = qm Then

sf1 = SerieFreqTurbo(Ini,fin,nu,aruote,2)

sf2 = SerieFreqTurbo(Ini,Fin,nu,aruote,3)

sf3 = SerieFreqTurbo(Ini,Fin,nu,aruote,4)

sf4 = SerieFreqTurbo(Ini,Fin,nu,aruote,5)

'Tot = Tot + SF

sr1 = SerieRitardoTurbo(Ini,fin,nu,aruote,2)

sr2 = SerieRitardoTurbo(Ini,fin,nu,aruote,3)

sr3 = SerieRitardoTurbo(Ini,fin,nu,aruote,4)

sr4 = SerieRitardoTurbo(Ini,fin,nu,aruote,5)

st1 = SerieStoricoTurbo(Ini,fin,nu,aruote,2)

st2 = SerieStoricoTurbo(Ini,fin,nu,aruote,3)

st3 = SerieStoricoTurbo(Ini,fin,nu,aruote,4)

st4 = SerieStoricoTurbo(Ini,fin,nu,aruote,5)

Call VerificaEsitoTurbo(nu,aruote,fin - sr1,2,1,,retesito,,retestratti,id)

'End If

'Next

ReDim avalori(19)

avalori(1) = n

avalori(2) = StringaNumeri(nu)

avalori(3) = sf1

avalori(4) = sf2

avalori(5) = sf3

avalori(6) = sf4

avalori(7) = sr1

avalori(8) = sr2

avalori(9) = sr3

avalori(10) = sr4

avalori(11) = st1

avalori(12) = st2

avalori(13) = st3

avalori(14) = st4

avalori(15) = retesito

avalori(16) = retestratti

If retesito = "Ambo" Then avalori(17) = DataEstrazione(id,1)

If retesito = "Terno" Then avalori(17) = DataEstrazione(id,1)

If retesito = "Quaterna" Then avalori(17) = DataEstrazione(id,1)

If retesito = "" Then avalori(17) = " Negativo "

'avalori(17) = DataEstrazione(id)

If avalori(17) = DataEstrazione(id,1) Then avalori(18) =(Mese(id))

If Sabato(id) Then avalori(19) = " Sabato "

If giovedi(id) Then avalori(19) = " Giovedì "

If martedi(id) Then avalori(19) = " Martedì "

Call AddRigaTabella(avalori,,,3)

Call SetColoreCella(3,vbGreen)

Call SetColoreCella(4,vbGreen)

Call SetColoreCella(5,vbGreen)

Call SetColoreCella(6,vbGreen)

Call SetColoreCella(7,vbRed)

Call SetColoreCella(8,vbRed)

Call SetColoreCella(9,vbRed)

Call SetColoreCella(10,vbRed)

Call SetColoreCella(11,vbMagenta)

Call SetColoreCella(12,vbMagenta)

Call SetColoreCella(13,vbMagenta)

Call SetColoreCella(14,vbMagenta)

If avalori(7) = 0 Then Call SetColoreCella(17,2,4)

If retesito = "Ambo" Then Call SetColoreCella(15,4,2)

If retesito = "Terno" Then Call SetColoreCella(15,3,1)

If avalori(18) = 1 Then m1 = m1 + 1

If avalori(18) = 2 Then m2 = m2 + 1

If avalori(18) = 3 Then m3 = m3 + 1

If avalori(18) = 4 Then m4 = m4 + 1

If avalori(18) = 5 Then m5 = m5 + 1

If avalori(18) = 6 Then m6 = m6 + 1

If avalori(18) = 7 Then m7 = m7 + 1

If avalori(18) = 8 Then m8 = m8 + 1

If avalori(18) = 9 Then m9 = m9 + 1

If avalori(18) = 10 Then m10 = m10 + 1

If avalori(18) = 11 Then m11 = m11 + 1

If avalori(18) = 12 Then m12 = m12 + 1

If avalori(19) = " Sabato " Then sb = sb + 1

If avalori(19) = " Giovedì " Then g = g + 1

If avalori(19) = " Martedì " Then m = m + 1

Next

Scrivi

Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1

Call SetTableWidth("100%")

Call CreaTabella()

Scrivi "CASI..." & MeseNome(1) & vbTab & " = " & m1

Scrivi "CASI..." & MeseNome(2) & vbTab & " = " & m2

Scrivi "CASI..." & MeseNome(3) & vbTab & " = " & m3

Scrivi "CASI..." & MeseNome(4) & vbTab & " = " & m4

Scrivi "CASI..." & MeseNome(5) & vbTab & " = " & m5

Scrivi "CASI..." & MeseNome(6) & vbTab & " = " & m6

Scrivi "CASI..." & MeseNome(7) & vbTab & " = " & m7

Scrivi "CASI..." & MeseNome(8) & vbTab & " = " & m8

Scrivi "CASI..." & MeseNome(9) & vbTab & " = " & m9

Scrivi "CASI..." & MeseNome(10) & vbTab & " = " & m10

Scrivi "CASI..." & MeseNome(11) & vbTab & " = " & m11

Scrivi "CASI..." & MeseNome(12) & vbTab & " = " & m12

Scrivi

Scrivi "Casi al Sabato...." & sb

Scrivi "Casi al Giovedì..." & g

Scrivi "Casi al Martedì..." & m

Scrivi

Call PicStampaTesto(1,10,"Listed by Mike58 ",,1,1,,11,vbRed)

PicEsegui

End Sub

Function Sabato(id)

Sabato = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbSaturday Then Sabato = True

End Function

Function giovedi(id)

giovedi = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbThursday Then giovedi = True

End Function

Function martedi(id)

martedi = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbTuesday Then martedi = True

End Function


2° script permette di prelevare un file esterno da una locazione scelta e verificarne gli esiti.

Codice:
'Option Explicit

Class clsCombinazione

Private aNumeri

Function SetNumeriFromRiga(sRiga,sChrSep)

Dim k,nUpper

ReDim aV(0)

Call SplitByChar(sRiga," ",aV)

nUpper = 0

ReDim aNumeri(nUpper)

For k = 0 To UBound(aV)

If IsNumeric(aV(k)) Then

If isNumeroValidoLotto(CInt(aV(k))) Then

nUpper = nUpper + 1

ReDim Preserve aNumeri(nUpper)

aNumeri(nUpper) = CInt(aV(k))

End If

End If

Next

If nUpper > 0 Then

SetNumeriFromRiga = True

Else

SetNumeriFromRiga = False

End If

End Function

Sub GetArrayNumeri(aNum)

aNum = aNumeri

End Sub

End Class

Sub AlimentaCollComb(sFile,Coll,sChrSep)

Dim k

Dim clsComb

Set Coll = GetNewCollection

ReDim aRighe(0)

Call LeggiRigheFileDiTesto (sFile,aRighe)

For k = 0 To UBound(aRighe)

Set clsComb = New clsCombinazione

If clsComb.SetNumeriFromRiga(aRighe(k),sChrSep) Then

Coll.Add clsComb

End If

Next

End Sub

Sub Main

Dim sFileCombinazioni

Dim sDirDef

Dim CollCombinazioni

Dim clsComb

Dim aNumeri

'Dim Ruote(1)

quante = CInt(InputBox("QUANTE ESTRAZIONI VUOI ANALIZZARE",,10))

sDirDef = GetDirectoryAppData

sFileCombinazioni = ScegliFile(sDirDef,".txt")

ReDim Ruote(0)

Rr = ScegliRuote(Ruote)

Call AlimentaCollComb(sFileCombinazioni,CollCombinazioni,".")

' ciclo su tutte le combinazioni da analizzare

For Each clsComb In CollCombinazioni

kn = kn + 1

Call clsComb.GetArrayNumeri(aNumeri)

' ora abbiamo i numeri della combinazione corrente

' semplicemente per esempio scrivo la stringa numeri ma in un caso reale

' qui mettero il codice che lavora con la combinazione corrente

Ini = EstrazioneFin - quante

fin = EstrazioneFin

Call Scrivi(FormatSpace(kn,2) & vbTab & StringaNumeri(aNumeri,,True),1,1,,1,3)

Ini = fin - quante

ReDim T(5)

T(1) = " Casi "

T(2) = " Data Estrazione "

T(3) = " Estratti "

T(4) = " Esito "

T(5) = " Ritardo per Ambo "

Call InitTabella(T,2,,3,5)

For es = fin To Ini Step - 1

Call VerificaEsito(aNumeri,Ruote,es,1,1,,esito,clp,estratti,id)

Call StatisticaFormazione(aNumeri,Ruote,2,rit,max,Incr,freq,Ini,es)

'End If

'ImpostaGiocataDL 1,aNumeri,1,10

'GiocaDL es

ReDim V(5)

V(1) = fin - es

V(2) = GetInfoEstrazione(es)

V(3) = estratti

V(4) = esito

V(5) = rit

Call AddRigaTabella(V,,,3)

If V(4) = "Estratto" Then k1 = k1 + 1

If V(4) = "Ambo" Then k2 = k2 + 1

If V(4) = "Terno" Then k3 = k3 + 1

If V(4) = "Quaterna" Then k4 = k4 + 1

If V(4) = "Cinquina" Then k5 = k5 + 1

If V(4) = "Sestina" Then k6 = k6 + 1

If V(4) = "sette" Then k7 = k7 + 1

If V(4) = "Otto" Then k8 = k8 + 1

If V(4) = "Nove" Then k9 = k9 + 1

If V(4) = "Dieci" Then k10 = k10 + 1

'----------------------------------------

If V(4) = "Estratto" Then kk1 = kk1 + 1

If V(4) = "Ambo" Then kk2 = kk2 + 1

If V(4) = "Terno" Then kk3 = kk3 + 1

If V(4) = "Quaterna" Then kk4 = kk4 + 1

If V(4) = "Cinquina" Then kk5 = kk5 + 1

If V(4) = "Sestina" Then kk6 = kk6 + 1

If V(4) = "sette" Then kk7 = kk7 + 1

If V(4) = "Otto" Then kk8 = kk8 + 1

If V(4) = "Nove" Then kk9 = kk9 + 1

If V(4) = "Dieci" Then kk10 = kk10 + 1

'If esito <> "" Then

'Scrivi vbTab & FormatSpace(fin-es,2) & vbTab & DataEstrazioneDL(es) & vbTab & estratti & vbTab & StringaEstrattiDL(es) & vbTab & esito

'End If

'If esito = "" Then

'Scrivi String(95,".") & " nessun esito "

'End If

Next

'If esito = "Estratto" Then k1 = k1 + 1

Scrivi "Estratto......" & k1

Scrivi "Ambo.........." & k2

Scrivi "Terno........." & k3

Scrivi "Quaterna......" & k4

Scrivi "Cinquina......" & k5

Scrivi "Sei..........." & k6

Scrivi "Sette........." & k7

Scrivi "Otto.........." & k8

Scrivi "nove.........." & k9

Scrivi "Dieci........." & k10

Call SetTableWidth("100%")

Call CreaTabella()

k1 = 0

k2 = 0

k3 = 0

k4 = 0

k5 = 0

k6 = 0

k7 = 0

k8 = 0

k9 = 0

k10 = 0

Next

Scrivi

Scrivi " ****** Script By Mike58 ****** Forum lottoCed ****** Richiesta LottoTom75 ****** ",1,1,2,4,3

Scrivi

Scrivi "Riepilogo Finale cumulativo",1

Scrivi "---------------------------"

Scrivi "Estratto......" & kk1

Scrivi "Ambo.........." & kk2

Scrivi "Terno........." & kk3

Scrivi "Quaterna......" & kk4

Scrivi "Cinquina......" & kk5

Scrivi "Sei..........." & kk6

Scrivi "Sette........." & kk7

Scrivi "Otto.........." & kk8

Scrivi "nove.........." & kk9

Scrivi "Dieci........." & kk10

End Sub


Gli script sono stati modificati per lo scopo ad esempio è sono suscettibili di migliorie ad ok.
Il carattere separatore è " " spazio modificabile dal codice seguente: Call SplitByChar(sRiga," ",aV)

Ciao prova ci leggiamo stasera.
 
Ultima modifica:
Mike58;n1913398 ha scritto:
Ciao Tom, arrivo adesso dal lavoro, eleggo adesso.

Ti Posso dire che gli script si possono fare per entrambe le tipologie, solo dammi il tempo per la concentrazione ed il tempo necessario.

Ti faccio sapere al più presto


Letto solo ora, grazie miticissimo amico.
 
Mike58;n1913512 ha scritto:
Ciao Tom, purtroppo il lavoro incombe e tempo a disposizione poco.

Come ti dicevo è possibile fare l'analisi nelle 2 forme

1° script permette di inserire le righe che credi in un array e verificarne la statistica voluta.

Codice:
Sub Main

Dim cmb(10)' aumentare il contatore pari al numero di combinazioni da cercare

Dim Ru(1)

Dim k,es

Dim nu

'qm = CInt(InputBox("Quale mese vuoi considerare ",,1))

ReDim aruote(12)

Scrivi " Ruota di... ",1,0,4

If ScegliRuote(aruote) > 0 Then

For k = 1 To UBound(aruote)

If aruote(k) > 0 Then

Scrivi " " & NomeRuota(aruote(k)),1,0,3

End If

Next

End If

Fin = EstrazioneFin

Ini = EstrazioneIni '8643'

Scrivi NomeRuota(Ru(1)),1,0

Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)

Scrivi

ReDim atitoli(19)

atitoli(1) = " N. CMB "

atitoli(2) = " Combinazione "

atitoli(3) = " Freq x 2 "

atitoli(4) = " Freq x 3 "

atitoli(5) = " Freq x 4 "

atitoli(6) = " Freq x 5 "

atitoli(7) = " Rit x 2 "

atitoli(8) = " Rit x 3 "

atitoli(9) = " Rit x 4 "

atitoli(10) = " Ritx 5"

atitoli(11) = " St.x 2 "

atitoli(12) = " st.x 3 "

atitoli(13) = " st.x 4 "

atitoli(14) = " st.x 5 "

atitoli(15) = " Esito "

atitoli(16) = " Stringa estratti "

atitoli(17) = " data esito "

atitoli(18) = " mese "

atitoli(19) = " Giorno "

Call InitTabella(atitoli,1,,3,5)

'-------------inserimento combinazioni --------------------------

cmb(1) = "33-02-03-61-62"

cmb(2) = "33-02"

cmb(3) = "33-03"

cmb(4) = "33-04"

cmb(5) = "61-62"

cmb(6) = "71-73-74-75"

cmb(7) = "61-62-83-84"

cmb(8) = "81-34-66-90"

cmb(9) = "16-45-67-89"

cmb(10) = "23-32-43-76"

'----------------- fine combinazioni ------------------------------

For N = 1 To UBound(cmb)

nu =(Split("0-" &(cmb(N)),"-"))

'For es = Ini To fin

'If Mese(es) = qm Then

sf1 = SerieFreqTurbo(Ini,fin,nu,aruote,2)

sf2 = SerieFreqTurbo(Ini,Fin,nu,aruote,3)

sf3 = SerieFreqTurbo(Ini,Fin,nu,aruote,4)

sf4 = SerieFreqTurbo(Ini,Fin,nu,aruote,5)

'Tot = Tot + SF

sr1 = SerieRitardoTurbo(Ini,fin,nu,aruote,2)

sr2 = SerieRitardoTurbo(Ini,fin,nu,aruote,3)

sr3 = SerieRitardoTurbo(Ini,fin,nu,aruote,4)

sr4 = SerieRitardoTurbo(Ini,fin,nu,aruote,5)

st1 = SerieStoricoTurbo(Ini,fin,nu,aruote,2)

st2 = SerieStoricoTurbo(Ini,fin,nu,aruote,3)

st3 = SerieStoricoTurbo(Ini,fin,nu,aruote,4)

st4 = SerieStoricoTurbo(Ini,fin,nu,aruote,5)

Call VerificaEsitoTurbo(nu,aruote,fin - sr1,2,1,,retesito,,retestratti,id)

'End If

'Next

ReDim avalori(19)

avalori(1) = n

avalori(2) = StringaNumeri(nu)

avalori(3) = sf1

avalori(4) = sf2

avalori(5) = sf3

avalori(6) = sf4

avalori(7) = sr1

avalori(8) = sr2

avalori(9) = sr3

avalori(10) = sr4

avalori(11) = st1

avalori(12) = st2

avalori(13) = st3

avalori(14) = st4

avalori(15) = retesito

avalori(16) = retestratti

If retesito = "Ambo" Then avalori(17) = DataEstrazione(id,1)

If retesito = "Terno" Then avalori(17) = DataEstrazione(id,1)

If retesito = "Quaterna" Then avalori(17) = DataEstrazione(id,1)

If retesito = "" Then avalori(17) = " Negativo "

'avalori(17) = DataEstrazione(id)

If avalori(17) = DataEstrazione(id,1) Then avalori(18) =(Mese(id))

If Sabato(id) Then avalori(19) = " Sabato "

If giovedi(id) Then avalori(19) = " Giovedì "

If martedi(id) Then avalori(19) = " Martedì "

Call AddRigaTabella(avalori,,,3)

Call SetColoreCella(3,vbGreen)

Call SetColoreCella(4,vbGreen)

Call SetColoreCella(5,vbGreen)

Call SetColoreCella(6,vbGreen)

Call SetColoreCella(7,vbRed)

Call SetColoreCella(8,vbRed)

Call SetColoreCella(9,vbRed)

Call SetColoreCella(10,vbRed)

Call SetColoreCella(11,vbMagenta)

Call SetColoreCella(12,vbMagenta)

Call SetColoreCella(13,vbMagenta)

Call SetColoreCella(14,vbMagenta)

If avalori(7) = 0 Then Call SetColoreCella(17,2,4)

If retesito = "Ambo" Then Call SetColoreCella(15,4,2)

If retesito = "Terno" Then Call SetColoreCella(15,3,1)

If avalori(18) = 1 Then m1 = m1 + 1

If avalori(18) = 2 Then m2 = m2 + 1

If avalori(18) = 3 Then m3 = m3 + 1

If avalori(18) = 4 Then m4 = m4 + 1

If avalori(18) = 5 Then m5 = m5 + 1

If avalori(18) = 6 Then m6 = m6 + 1

If avalori(18) = 7 Then m7 = m7 + 1

If avalori(18) = 8 Then m8 = m8 + 1

If avalori(18) = 9 Then m9 = m9 + 1

If avalori(18) = 10 Then m10 = m10 + 1

If avalori(18) = 11 Then m11 = m11 + 1

If avalori(18) = 12 Then m12 = m12 + 1

If avalori(19) = " Sabato " Then sb = sb + 1

If avalori(19) = " Giovedì " Then g = g + 1

If avalori(19) = " Martedì " Then m = m + 1

Next

Scrivi

Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1

Call SetTableWidth("100%")

Call CreaTabella()

Scrivi "CASI..." & MeseNome(1) & vbTab & " = " & m1

Scrivi "CASI..." & MeseNome(2) & vbTab & " = " & m2

Scrivi "CASI..." & MeseNome(3) & vbTab & " = " & m3

Scrivi "CASI..." & MeseNome(4) & vbTab & " = " & m4

Scrivi "CASI..." & MeseNome(5) & vbTab & " = " & m5

Scrivi "CASI..." & MeseNome(6) & vbTab & " = " & m6

Scrivi "CASI..." & MeseNome(7) & vbTab & " = " & m7

Scrivi "CASI..." & MeseNome(8) & vbTab & " = " & m8

Scrivi "CASI..." & MeseNome(9) & vbTab & " = " & m9

Scrivi "CASI..." & MeseNome(10) & vbTab & " = " & m10

Scrivi "CASI..." & MeseNome(11) & vbTab & " = " & m11

Scrivi "CASI..." & MeseNome(12) & vbTab & " = " & m12

Scrivi

Scrivi "Casi al Sabato...." & sb

Scrivi "Casi al Giovedì..." & g

Scrivi "Casi al Martedì..." & m

Scrivi

Call PicStampaTesto(1,10,"Listed by Mike58 ",,1,1,,11,vbRed)

PicEsegui

End Sub

Function Sabato(id)

Sabato = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbSaturday Then Sabato = True

End Function

Function giovedi(id)

giovedi = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbThursday Then giovedi = True

End Function

Function martedi(id)

martedi = False

Data = Replace(DataEstrazione(id),".","/")

Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)

Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann

If WeekDay(Data) = vbTuesday Then martedi = True

End Function


2° script permette di prelevare un file esterno da una locazione scelta e verificarne gli esiti.

Codice:
'Option Explicit

Class clsCombinazione

Private aNumeri

Function SetNumeriFromRiga(sRiga,sChrSep)

Dim k,nUpper

ReDim aV(0)

Call SplitByChar(sRiga," ",aV)

nUpper = 0

ReDim aNumeri(nUpper)

For k = 0 To UBound(aV)

If IsNumeric(aV(k)) Then

If isNumeroValidoLotto(CInt(aV(k))) Then

nUpper = nUpper + 1

ReDim Preserve aNumeri(nUpper)

aNumeri(nUpper) = CInt(aV(k))

End If

End If

Next

If nUpper > 0 Then

SetNumeriFromRiga = True

Else

SetNumeriFromRiga = False

End If

End Function

Sub GetArrayNumeri(aNum)

aNum = aNumeri

End Sub

End Class

Sub AlimentaCollComb(sFile,Coll,sChrSep)

Dim k

Dim clsComb

Set Coll = GetNewCollection

ReDim aRighe(0)

Call LeggiRigheFileDiTesto (sFile,aRighe)

For k = 0 To UBound(aRighe)

Set clsComb = New clsCombinazione

If clsComb.SetNumeriFromRiga(aRighe(k),sChrSep) Then

Coll.Add clsComb

End If

Next

End Sub

Sub Main

Dim sFileCombinazioni

Dim sDirDef

Dim CollCombinazioni

Dim clsComb

Dim aNumeri

'Dim Ruote(1)

quante = CInt(InputBox("QUANTE ESTRAZIONI VUOI ANALIZZARE",,10))

sDirDef = GetDirectoryAppData

sFileCombinazioni = ScegliFile(sDirDef,".txt")

ReDim Ruote(0)

Rr = ScegliRuote(Ruote)

Call AlimentaCollComb(sFileCombinazioni,CollCombinazioni,".")

' ciclo su tutte le combinazioni da analizzare

For Each clsComb In CollCombinazioni

kn = kn + 1

Call clsComb.GetArrayNumeri(aNumeri)

' ora abbiamo i numeri della combinazione corrente

' semplicemente per esempio scrivo la stringa numeri ma in un caso reale

' qui mettero il codice che lavora con la combinazione corrente

Ini = EstrazioneFin - quante

fin = EstrazioneFin

Call Scrivi(FormatSpace(kn,2) & vbTab & StringaNumeri(aNumeri,,True),1,1,,1,3)

Ini = fin - quante

ReDim T(5)

T(1) = " Casi "

T(2) = " Data Estrazione "

T(3) = " Estratti "

T(4) = " Esito "

T(5) = " Ritardo per Ambo "

Call InitTabella(T,2,,3,5)

For es = fin To Ini Step - 1

Call VerificaEsito(aNumeri,Ruote,es,1,1,,esito,clp,estratti,id)

Call StatisticaFormazione(aNumeri,Ruote,2,rit,max,Incr,freq,Ini,es)

'End If

'ImpostaGiocataDL 1,aNumeri,1,10

'GiocaDL es

ReDim V(5)

V(1) = fin - es

V(2) = GetInfoEstrazione(es)

V(3) = estratti

V(4) = esito

V(5) = rit

Call AddRigaTabella(V,,,3)

If V(4) = "Estratto" Then k1 = k1 + 1

If V(4) = "Ambo" Then k2 = k2 + 1

If V(4) = "Terno" Then k3 = k3 + 1

If V(4) = "Quaterna" Then k4 = k4 + 1

If V(4) = "Cinquina" Then k5 = k5 + 1

If V(4) = "Sestina" Then k6 = k6 + 1

If V(4) = "sette" Then k7 = k7 + 1

If V(4) = "Otto" Then k8 = k8 + 1

If V(4) = "Nove" Then k9 = k9 + 1

If V(4) = "Dieci" Then k10 = k10 + 1

'----------------------------------------

If V(4) = "Estratto" Then kk1 = kk1 + 1

If V(4) = "Ambo" Then kk2 = kk2 + 1

If V(4) = "Terno" Then kk3 = kk3 + 1

If V(4) = "Quaterna" Then kk4 = kk4 + 1

If V(4) = "Cinquina" Then kk5 = kk5 + 1

If V(4) = "Sestina" Then kk6 = kk6 + 1

If V(4) = "sette" Then kk7 = kk7 + 1

If V(4) = "Otto" Then kk8 = kk8 + 1

If V(4) = "Nove" Then kk9 = kk9 + 1

If V(4) = "Dieci" Then kk10 = kk10 + 1

'If esito <> "" Then

'Scrivi vbTab & FormatSpace(fin-es,2) & vbTab & DataEstrazioneDL(es) & vbTab & estratti & vbTab & StringaEstrattiDL(es) & vbTab & esito

'End If

'If esito = "" Then

'Scrivi String(95,".") & " nessun esito "

'End If

Next

'If esito = "Estratto" Then k1 = k1 + 1

Scrivi "Estratto......" & k1

Scrivi "Ambo.........." & k2

Scrivi "Terno........." & k3

Scrivi "Quaterna......" & k4

Scrivi "Cinquina......" & k5

Scrivi "Sei..........." & k6

Scrivi "Sette........." & k7

Scrivi "Otto.........." & k8

Scrivi "nove.........." & k9

Scrivi "Dieci........." & k10

Call SetTableWidth("100%")

Call CreaTabella()

k1 = 0

k2 = 0

k3 = 0

k4 = 0

k5 = 0

k6 = 0

k7 = 0

k8 = 0

k9 = 0

k10 = 0

Next

Scrivi

Scrivi " ****** Script By Mike58 ****** Forum lottoCed ****** Richiesta LottoTom75 ****** ",1,1,2,4,3

Scrivi

Scrivi "Riepilogo Finale cumulativo",1

Scrivi "---------------------------"

Scrivi "Estratto......" & kk1

Scrivi "Ambo.........." & kk2

Scrivi "Terno........." & kk3

Scrivi "Quaterna......" & kk4

Scrivi "Cinquina......" & kk5

Scrivi "Sei..........." & kk6

Scrivi "Sette........." & kk7

Scrivi "Otto.........." & kk8

Scrivi "nove.........." & kk9

Scrivi "Dieci........." & kk10

End Sub


Gli script sono stati modificati per lo scopo ad esempio è sono suscettibili di migliorie ad ok.
Il carattere separatore è " " spazio modificabile dal codice seguente: CallSplitByChar(sRiga,"",aV)

Ciao prova ci leggiamo stasera.


Come scritto sopra letto solo ora e ... :eek: :D sicuro di non essere Luigi sotto mentite spoglie? :p ;) Grazie mille monster (in senso più che buono)! Provo il prima possibile e ti faccio sapere come vanno le tue due stupende creazioni! :) Ciao and good sunday Mike! :D
 
Ultima modifica:

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 23 gennaio 2025
    Bari
    86
    50
    83
    38
    78
    Cagliari
    11
    36
    52
    31
    74
    Firenze
    56
    59
    86
    27
    84
    Genova
    03
    61
    53
    11
    38
    Milano
    13
    14
    79
    87
    47
    Napoli
    21
    90
    48
    55
    37
    Palermo
    56
    46
    59
    02
    53
    Roma
    74
    13
    07
    38
    77
    Torino
    27
    54
    62
    36
    81
    Venezia
    09
    14
    69
    28
    62
    Nazionale
    32
    73
    27
    11
    51
    Estrazione Simbolotto
    Bari
    36
    27
    19
    08
    24
Indietro
Alto