Novità

Creare elenco presenze

Xeroxs

Senior Member
Messaggi
145
Punti reazione
7
Punti
18
Scusami Silop avevo ricopiato alla veloce uno stralcio di esiti che mi ha passato un amico senza vedere al meglio la cosa scritta.
 

Xeroxs

Senior Member
Messaggi
145
Punti reazione
7
Punti
18
Ciao
*blacklotto*

I valori riportati da I LEGEND sembrano esatti anche con verifica manuale,
ora perchè solo due numeri non corrispondono per me me è difficile capirlo, posso solo pensare al range di date o indice ma non credo che sia questo il caso
 

claudio8

Advanced Member >PLATINUM PLUS<
Messaggi
3.341
Punti reazione
189
Punti
63
Attenziona all'utilizzo della semplice sommatoria del risultato della funzione frequenza perche quanto state alaborando, per un utilizzo di effettivo gioco ha valenza solo se il range di ricerca freq e' di una sola estrazione.

X Blacklotto
Probabilmente devi controllare l'archivio.

Un saluto
 

i legend

Advanced Member >PLATINUM PLUS<
Messaggi
3.773
Punti reazione
377
Punti
83
Ciao Claudio lo script rileva tutti gli estratti e ambi sortiti nell estrazione corrispondente all indice mensile.
Nel calcolo a tutte se un ambo sortisce su più ruote viene conteggiato più volte come è corretto che sia in quanto è la stessa estrazione.
Farlo su più estrazioni cambierebbe la logica dello script.
Grazie Claudio.
I valori postati ti risultano esatti ?
 

claudio8

Advanced Member >PLATINUM PLUS<
Messaggi
3.341
Punti reazione
189
Punti
63
Ciao "Leggenda" .... come avrai letto ho parlato di singola estrazione.
Il mio è un suggerimento indirizzato ai meno esperti.
Riguardo all'esattezza dei dati non posso verificare perché sto scrivendo da cellulare.
Un saluto
 

*blacklotto*

Senior Member
Messaggi
106
Punti reazione
4
Punti
18
scusa I Legend
più volte dicevi che avresti inserito lo script che usavi per tal ricerca.
Se ciò non fosse un problema per te, gradirei provarne l'esecuzione.
 

i legend

Advanced Member >PLATINUM PLUS<
Messaggi
3.773
Punti reazione
377
Punti
83
Ciao , lo script come l ho scritto non mi piace. Credo che sia buono, ma voglio ottimizzarlo. Purtroppo il lavoro occupa molto tempo , la mia famiglia è al primo posto al secondo gli svaghi, gli script sono al secondo posto.

Se non voglio rendere pubblico uno script lo scrivo subito ,
Non è questo il caso.
Ma Se non riesco ad ottimizzarlo non lo posterò.
Per me è importante.
Ciao :)
 

Master

Advanced Member >GOLD<
Messaggi
775
Punti reazione
28
Punti
28
Ciao a tutti
Ho fatto un modesto script con l'output come richiesto da Xeroxs
X blacklotto i miei risultati i corrispondono a quelli di i legend
controllare sempre
scaricare sopra #9

Buona serata
 

i legend

Advanced Member >PLATINUM PLUS<
Messaggi
3.773
Punti reazione
377
Punti
83
Ciao bravo master.
Appena riesco posto anche la mia.
 

i legend

Advanced Member >PLATINUM PLUS<
Messaggi
3.773
Punti reazione
377
Punti
83
Ciao a tutti
non garantisco che i risultati siano esatti,fate voi le verifiche
ho provato a dare anche io una versione dello script.
lo script rileva gli estratti gli ambi e i terni
piu aumenta il numero degli ambi da analizzare piu aumenta il tempo.
ho cercato di gestire i possibili errori di input, questo rallenta un po
per chi vuole studiare la procedura ho diviso tutto in piccole funzioni
si puo ottimizzare ? sicuramente
si puo velocizzare? sicuramente
se non il prof visto la sua momentanea assenza forse Giggio, conoscendo le classi potrebbe migliorare i tempi ,o Joe
ecco lo script
controllate se i dati di input combacino con quelli di output,
l errore è sempre dietro l angolo
Codice:
Option Explicit
Class ClsAmboPres
   Dim strAmbo
   Dim nPres
   Sub IncrementaPres
      nPres = nPres + 1
   End Sub
End Class
Class ClsTernoPres
   Dim StrTerno
   Dim nPres
   Sub IncrementaPres
      nPres = nPres + 1
   End Sub
End Class
Sub Main
   Dim Mess,Ini,iAnnoFin
   Dim iIdM,sIdMese,IdEstr
   Dim Ruota,sRuota,iRuIni,iRuFin
   Dim bEstr,p,E,p1,E1,p2,E2
   Dim iEstrFiltr,IdPriEstrUti,idUltEstrUti
   Dim MaxFreqA,MaxFreqT
   Dim sAmbo,sTerno
   Dim Coll,CollT
   Dim ClsAmbo,ClsTerno
   ReDim aEstratti(90,2)
   If Not ImpostaParametri(Ini,iAnnoFin,iIdM,sIdMese,sRuota,iRuIni,iRuFin) Then Exit Sub
   '  Scrivi Ini & "  ,  " & iAnnoFin & "  ,  " & iIdM & "  ,  " & sIdMese & "  ,  " & sRuota & "  ,  " & iRuIni & "  ,  " & iRuFin
   Call ResetTimer
   For E = 1 To UBound(aEstratti)
      aEstratti(E,1) = E
      aEstratti(E,2) = 0
   Next
   iEstrFiltr = 0
   IdPriEstrUti = EstrazioneFin
   idUltEstrUti = 0
   Set Coll = GetNewCollection
   Set CollT = GetNewCollection
   For IdEstr = Ini To EstrazioneFin
      If GetValidaIndicemensile(IdEstr,iIdM) Then ' funzione che valida l indice mensile voluto
         For Ruota = iRuIni To iRuFin
            If Estratto(IdEstr,Ruota,1) Then
               'Scrivi IdEstr & "   " & IndiceMensile(IdEstr) & "  " & IndiceAnnuale(IdEstr) & "    " & DataEstrazione(IdEstr)
               ReDim aEstr(0)
               Call GetArrayNumeriRuota(IdEstr,Ruota,aEstr)
               Call OrdinaMatriceTurbo(aEstr,1)
               bEstr = True
               For p = 1 To 5
                  E = aEstr(p)
                  aEstratti(E,2) = aEstratti(E,2) + 1
               Next
               ' se rieesco con la classe a mettere tutto in collection
               For p = 1 To 4
                  For p1 = p + 1 To 5
                     Set ClsAmbo = New ClsAmboPres
                     E = aEstr(p)
                     E1 = aEstr(p1)
                     sAmbo = Format2(E) & "  " & Format2(E1)
                     Call GetIncrementaAmbo(sAmbo,Coll,MaxFreqA)
                  Next
               Next
               For p = 1 To 3
                  For p1 = p + 1 To 4
                     For p2 = p1 + 1 To 5
                        Set ClsTerno = New ClsTernoPres
                        E = aEstr(p)
                        E1 = aEstr(p1)
                        E2 = aEstr(p2)
                        sTerno = Format2(E) & "  " & Format2(E1) & "  " & Format2(E2)
                        Call GetIncrementaTerno(sTerno,CollT,MaxFreqT)
                     Next
                  Next
               Next
            End If
         Next
         If bEstr Then
            iEstrFiltr = iEstrFiltr + 1 ' se bret è true allora aumento di uno l estrazione valida
            If IdPriEstrUti > IdEstr Then IdPriEstrUti = IdEstr ' trovo la prima estrazione utile
            If idUltEstrUti < IdEstr Then idUltEstrUti = IdEstr ' trovo l ultima estrazioneutile
         End If
      End If
      Call AvanzamentoElab(Ini,EstrazioneFin,IdEstr)
   Next ' Idestr
   ' Blocco testo dati input e output
   Scrivi " Indice Mensile selezionato:  " & sIdMese
   Scrivi " Ruota di Ricerca:            " & sRuota
   Scrivi " Anno Inizio Ricerca:         " & GetInfoEstrazione(Ini)
   Scrivi " Anno Fine Ricerca:           " & GetInfoEstrazione(EstrazioneFin)
   Scrivi " Prima Estrazione Utile:      " & GetInfoEstrazione(IdPriEstrUti)
   Scrivi " Ultima Estrazione Utile:     " & GetInfoEstrazione(idUltEstrUti)
   Scrivi " Concorsi Filtrati:           " & iEstrFiltr
   Call GetTabellaEstratti(aEstratti)
   Dim iFreqMinA
   iFreqMinA = GetFreqMin("la frequenza massima dell ambo  riscontrata ","Seleziona la frequenza minima che vuoi visualizzare",MaxFreqA)
   Call GetTabellaAmbi(Coll,ClsAmbo,iFreqMinA)
   Dim iFreqMinT
   iFreqMinT = GetFreqMin("la frequenza massima del terno riscontrata ","Seleziona la frequenza minima che vuoi visualizzare",MaxFreqT)
   Call GetTabellaTerno(CollT,ClsTerno,iFreqMinT)
   Scrivi "Tempo elaborazione dati: " & TempoTrascorso
End Sub
Function GetMessaggioApertura
   Dim Mess
   Mess = "Verificare che i dati riportati siano esatti"
   Mess = Mess & vbCrLf & "Non se ne garantisce la correttezza"
   Mess = Mess & vbCrLf & "NESSUNO E' AUTORIZZATO A VENDERE LO SCRIPT  perchè dato gratuitamente per esempio compilazione"
   Mess = Mess & vbCrLf & "Vuoi proseguire?"
   GetMessaggioApertura = MsgBox(Mess,4 + 64,"Informazioni")
End Function
Function GetPrimaDellAnno(Ini)
   GetPrimaDellAnno = False
   Dim sAnno
   Dim iAnnoFin
   iAnnoFin = Anno(EstrazioneFin)
   sAnno = CInt(InputBox("Range possibile: " & vbCrLf & "   1871-" & iAnnoFin,"Inserisci Anno Inizio Ricerca",iAnnoFin)) ' inserisco l anno di inizio ricerca
   '  If sAnno >= 1871 And sAnno <= iAnnoFin Then ' se anno è valido trovo la prima estrazione dell anno di inizio ricerca
   Ini = PrimaSuccessiva("01/01/" & sAnno)
   If isIdEstrValido(Ini) Then
      GetPrimaDellAnno = True
   Else
      Call MsgBox("il: " & sAnno & " non è in archivio" & vbCrLf & "lo script non verrà eseguito",vbOKOnly,"Errore")
   End If
End Function
Function GetIndicemensile(iIdM,sIdMese)
   GetIndicemensile = False
   Dim aIdMese
   aIdMese = Array(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,"IsUltimaDelMese")
   iIdM = ScegliOpzioneMenu(aIdMese,0,"Seleziona Indice mensile")
   If iIdM >= 0 Then
      sIdMese = aIdMese(iIdM)
      iIdM = iIdM + 1
      GetIndicemensile = True
   Else
      Call MsgBox("Hai inserito un indicemensile non valido=" & iIdM,vbOKOnly,"Errore inserimento indice mensile")
   End If
End Function
Function GetRuotaDiCalcolo(sRuota,iRuIni,iRuFin)
   GetRuotaDiCalcolo = False
   Dim r
   r = ScegliRuota
   If isRuotaValidaLotto(r) Then
      GetRuotaDiCalcolo = True
      sRuota = NomeRuota(r)
      If r <> 11 Then
         iRuIni = r
         iRuFin = r
      Else
         iRuIni = 1
         iRuFin = 10
      End If
   Else
      Call MsgBox("Hai inserito una ruota  non valida",vbOKOnly,"Errore inserimento indice Ruota")
   End If
End Function
Function ImpostaParametri(Ini,iAnnoFin,iIdM,sIdMese,sRuota,iRuIni,iRuFin)
   Dim bRet
   bRet = False
   If GetMessaggioApertura = 6 Then
      If GetPrimaDellAnno(Ini) Then
         If GetIndicemensile(iIdM,sIdMese) Then
            If GetRuotaDiCalcolo(sRuota,iRuIni,iRuFin) Then
               bRet = True
            Else
               Exit Function
            End If
         Else
            Exit Function
         End If
      Else
         Exit Function
      End If
   Else
      Exit Function
   End If
   ImpostaParametri = bRet
End Function
Function GetValidaIndicemensile(idEstr,iIdMese)
   Dim bRet
   bRet = False
   If iIdMese < 16 Then
      If IndiceMensile(idEstr) = iIdMese Then bRet = True
   Else
      If IsUltimaDelMese(idEstr) Then bRet = True
   End If
   GetValidaIndicemensile = bRet
End Function
Sub GetIncrementaAmbo(sForm,coll,maxFreq)
   Dim sKey,cNum
   sKey = "k"
   sKey = sKey & sForm
   If GetItemCollection(coll,sKey,cNum) Then
      cNum.IncrementaPres
      If maxFreq < cNum.nPres Then maxFreq = cNum.nPres
   Else
      Set cNum = New ClsAmboPres
      cNum.strAmbo = sForm
      cNum.npres = 1
      Coll.Add cNum,sKey
   End If
End Sub
Sub GetIncrementaTerno(sForm,coll,MaxFreqT)
   Dim sKey,cNum
   sKey = "k"
   sKey = sKey & sForm
   If GetItemCollection(coll,sKey,cNum) Then
      cNum.IncrementaPres
      If MaxFreqT < cNum.npres Then MaxFreqT = cNum.npres
   Else
      Set cNum = New ClsTernoPres
      cNum.StrTerno = sForm
      cNum.npres = 1
      Coll.Add cNum,sKey
   End If
End Sub
Sub GetTabellaEstratti(aEstr)
   Dim aTit,aTab
   aTit = Array(0,"Estratti","NumeroNumeri","Presenze")
   Call InitTabella(aTit)
   Dim maxFreq,iNumNum,s,Id
   Call OrdinaMatriceTurbo(aEstr,- 1,2)
   maxFreq = aEstr(1,2)
   Do While maxFreq >= aEstr(90,2)
      s = ""
      iNumNum = 0
      For Id = 1 To UBound(aEstr)
         If Int(aEstr(Id,2)) = maxFreq Then
            s = s & Format2(aEstr(Id,1)) & "  "
            iNumNum = iNumNum + 1
         End If
      Next
      '  s = RimuoviLastChr(s,"  ")
      If iNumNum Then
         ' Scrivi "  " & FormatSpace(iNumNum,9,1) & "  |  " & FormatSpace(maxFreq,3) & "    |  " & s
         aTab = Array(0,s,iNumNum,maxFreq)
         Call AddRigaTabella(aTab)
      End If
      maxFreq = maxFreq - 1
   Loop
   Call SetTableHeight("40%")
   Call SetTableWidth("100%")
   Call CreaTabellaOrdinabile()
End Sub
Function GetFreqMin(sTesto1,stesto2,freqMax)
   Dim FreqMin
   FreqMin = ""
   Do While Not IsNumeric(FreqMin)
      FreqMin = InputBox(sTesto1 & " =" & freqMax,stesto2,freqMax)
   Loop
   GetFreqMin = CInt(FreqMin)
End Function
Sub GetTabellaAmbi(coll,ClsAmbo,Fmin)
   Call OrdinaItemCollection(coll,"nPres",,,- 1)
   Dim aTit,aTab,id
   aTit = Array(0,"Ambo","Presenze")
   Call InitTabella(aTit)
   For Each ClsAmbo In coll
      If ClsAmbo.npres < Fmin Then Exit For
      id = id + 1
      aTab = Array(0,clsambo.Strambo,clsAmbo.npres)
      
      Call AddRigaTabella(aTab)
      Call AvanzamentoElab(1,Coll.count,id)
   Next
   Call SetTableHeight("40%")
   Call SetTableWidth("100%")
   Call SetTableTitle(" Formazioni trovate: " & coll.count)
   Call CreaTabellaOrdinabile()
End Sub
Sub GetTabellaTerno(collt,ClsTerno,fMin)
   Call OrdinaItemCollection(collt,"nPres",,,- 1)
   Dim aTit,aTab
   aTit = Array(0,"Terno","Presenze")
   Call InitTabella(aTit)
   For Each ClsTerno In collt
      If ClsTerno.npres < fMin Then Exit For
      aTab = Array(0,clsterno.Strterno,clsTerno.npres)
      
      Call AddRigaTabella(aTab)
   Next
   Call SetTableHeight("40%")
   Call SetTableWidth("100%")
   Call SetTableTitle(" Formazioni trovate: " & collt.count)
   Call CreaTabellaOrdinabile()
End Sub
datemi la vostra opinione e i vostri riscontri
sono importanti (y)
 

Xeroxs

Senior Member
Messaggi
145
Punti reazione
7
Punti
18
Per I-Legend
Intanto Ti Ringrazio davvero per la realizzazione del listato ed anche del Tempo dedicato per realizzarlo.
Come sempre da ciò che ho visto dai precedenti un ottimo lavoro anche questo.
Riporta in modo molto strutturato i risultati che vanno ben oltre le mie aspettative.
Grazie Davvero,
Da ciò che vedo i risultati sembrano esatti, nelle prossime ore avrò modo di testarne altri risultati.
 

Xeroxs

Senior Member
Messaggi
145
Punti reazione
7
Punti
18
Per Master
In questi Giorni ho avuto modo di usare il tuo listato ed ho potuto testare il tuo ottimo lavoro,
Anche corretto nei risultati.
Grazie anche a Te.
 

Xeroxs

Senior Member
Messaggi
145
Punti reazione
7
Punti
18
Grazie al vostro aiuto riesco a mettere in pratica le mie idee per il gioco del lotto per spunti che spero porteranno a qualche esito positivo, restando sempre con i piedi a terra so bene che bisogna avere sempre e comunque molta fortuna. Intanto mi limito a testarne l'efficacia di quanto mi viene in mente.

Ora sto cercando di Verificare esiti (a mano) nei mesi scelti cercando di fissare i colpi e non solo tutto il mese, cercando di vedere se in alcuni periodi alcuni numeri hanno più frequenze nel breve periodo.

Grazie ancora a Tutti Voi, alla Prossima.
 

Master

Advanced Member >GOLD<
Messaggi
775
Punti reazione
28
Punti
28
Ciao tutti
X i legend hai fatto un Megascript... complimenti!!!

Buona giornata
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 08 agosto 2020
    Bari
    67
    68
    65
    64
    79
    Cagliari
    58
    72
    16
    48
    60
    Firenze
    09
    44
    66
    48
    10
    Genova
    13
    20
    34
    41
    09
    Milano
    87
    73
    59
    32
    15
    Napoli
    74
    58
    75
    71
    11
    Palermo
    30
    38
    81
    20
    32
    Roma
    29
    52
    41
    48
    28
    Torino
    61
    78
    71
    76
    25
    Venezia
    63
    24
    82
    40
    52
    Nazionale
    22
    60
    68
    69
    53
    Estrazione Simbolotto
    Genova
    02
    03
    16
    40
    23

Ultimi Messaggi

Alto