Per Joe

[solare]

Ciao, approfittando della tua cortesia, potresti trasformare questo listato per il 10elotto serale ?

Option Explicit
' controllare se lo script fa quanto richiesto
' si è utilizzato formattastringa e format 2 per un incolonnamento regolare
'salvo eventuali bugs sempre possibili
Sub Main
Dim Ini,Fin,IdEstr,R,P,sEstr,sChrSep
sChrSep = ";"
Call ScegliRange(Ini,Fin)
Call ResetTimer
For IdEstr = Ini To Fin
sEstr = DataEstrazione(IdEstr,,,"/") & sChrSep & FormattaStringa(IndiceAnnuale(IdEstr),"000") & sChrSep
For R = 1 To 12
If R = 11 Then R = 12
ReDim aEstr(0)
Call GetArrayNumeriRuota(IdEstr,R,aEstr)
For P = 1 To 5
sEstr = sEstr & Format2(aEstr(P)) & sChrSep
Next
Next
Scrivi RimuoviLastChr(sEstr,sChrSep)
Call AvanzamentoElab(Ini,Fin,IdEstr) ' aumenta il tempo di elaborazione
Next
Dim t:t = TempoTrascorso
If MsgBox("Vuoi visualizzare il tempo di elaborazioni dati?",4,"Opzione Output") = vbYes Then Scrivi t
End Sub

 

[joe]

Ciao Solare,

no mi spiace ma non conosco il format di quel gioco

ed a priori ... non considero (quasi un rifiuto a) "tutti questi" i giochi possibili ed immaginabili.

Anzi, penso sia sbagliato anche solo considerarli.

Perché essi assorbono capacità di calcolo, esperienze, risorse economiche,

alle poche disponibili che si possono dedicare ad un solo "ambiente",

al cospetto del quale, già è difficilissimo ottenere qualche minimo risultato.

Ad una prima lettura sembra un file per generare un archivio e ...

per organizzarsi ... in un gioco ... l'archivio si dovrebbe averlo.

Dunque non posso far altro che passare il testimone a chi vorrà o potrà,

aiutarti con maggiore generosità.

 

[solare]

ok grazie lo stesso

 

[Mike58]

Eccolo Solare

Option Explicit
Sub Main
ImpostaArchivio10ELotto(1)
Dim Ini,Fin,IdEstr,P,nu(20),sChrSep
sChrSep = ";"
Ini = EstrazioniArchivioDL-10
Fin = EstrazioniArchivioDL
Call ScegliRange(Ini,Fin,Ini,Fin)
Scrivi "Archivio 10 e Lotto Serale"
Scrivi "Estrazione inizio........... " & Ini
Scrivi "Estrazione fine............. " & Fin
Scrivi
Call ResetTimer
For IdEstr = Ini To Fin
For P = 1 To 20
nu(P) = EstrattoDL(IdEstr,P)
Next
Scrivi DataEstrazioneDL(IdEstr,,,"/") & sChrSep & FormattaStringa(IndiceAnnuale(IdEstr),"000") & sChrSep,1,0
Scrivi  StringaNumeri(nu,sChrSep,1),1,,,1
Call AvanzamentoElab(Ini,Fin,IdEstr)
Next
Dim t:t = TempoTrascorso
If MsgBox("Vuoi visualizzare il tempo di elaborazioni dati?",4,"Opzione Output") = vbYes Then Scrivi : Scrivi t
End Sub

 

[solare]

Ciao Mike58, ti ringrazio tantissimoooooooooo della tua cortesia e disponibilità
nell'occasione ed approfittando della tua vorrei chiederti se hai qualche listato che faccia la ricerca su quei numeri più frequenti in certi mesi o qualcosa di simile oppure qualcosa che mi indica i numeri simpatici che si abbinano al mio numero sempre nei mesi che io inserisco.
Buona giornata

 

[Mike58]

Ciao Solare,felice di esserti stato utile.

La richiesta dei Mesi penso sia fattibile ma pensata è costruita ad oc, così come i numeri simpatici o più frequenti in abbinamento al capogioco.

Per ora su 2 piedi mi è impossibile trovare lo spazio e tempo (causa turni lavorativi) adeguato per tale project.

Se trovo soluzione non mancherò.

Per ora un saluto

 

[Mike58]

Solare , tra il mio archivio script ho trovato uno script per i Numeri simpatici, listato dall' insuperabile Rubino, te lo posto perché trovo che sia uno script per questo gioco di inestimabile valore.

Sub Main
Dim Inizio,Fine,idEstr,pt2,pt1,pt0,pt3
Dim k,EntroColpi,e,ee,c,quanti,totest
Dim nBase,nUscito,presenzespia
Dim nUscite,kini,kfin,Orarin,Orarfi,gioco,kein
ReDim aPresenze(90,90),Incrocio(90)
Dim RetRit,RetRitMax,RetFreq
gioco = InputBox("1 = 10eLotto serale       2 = 10eLotto5Minuti",,1)
EntroColpi = CInt(InputBox("Entro quanti colpi ?","Colpi",1))
quanti = CInt(InputBox("Quanti numeri frequenti vuoi?",,7))
If gioco = 1 Then
Orarin = 0
Orarfi = 288
Else
Orarin = 49
Orarfi = 75
End If
kin = CInt(InputBox(" solo x 10Lotto5M Range Orario da n.:",,Orarin))
kfi = CInt(InputBox(" solo x 10Lotto5M Range Orario  a n. ",,Orarfi))
kein = CInt(InputBox(" solo x 10Lotto5M quanti giorni Estrazione indietro?",,500))
''''imposta archivio
Call ImpostaArchivio10ELotto(Int(gioco))
If gioco = 1 Then
Inizio = 8077
Fine = EstrazioneFin
Else
Fine = EstrazioniArchivioDL
Inizio = Fine - kein
End If
totest = Fine - Inizio
ColoreTesto(1)
If Int(gioco) = 1 Then
Scrivi " Namescript (SpiaefrequentiRubinoV2)    by(LuigiB - mod.Rubino) "
Scrivi " Archivio impostato su 10 E LOTTO SERALE   " & " Frequenti quantità " & quanti,1
Scrivi " n.estrazioni esaminate " & totest & "   Entro colpi n." & EntroColpi
Scrivi " dal.n.     al n.     " & Inizio & "/" & Fine
End If
If Int(gioco) = 2 Then
Scrivi " Archivio impostato su 1O E LOTTO 5 MINUTI " & " Frequenti quantità " & quanti,1
Scrivi " dal.n.     al n.     " & Inizio & "/" & Fine
OrEda = kin / 12
OrEa = kfi / 12
Scrivi " Ultime estrazioni esaminate " & totest & "   Entro colpi n." & EntroColpi & "     Range Orario :" & " ( " & Int(OrEda) & " : " & Int(OrEa) & " )" & " estr.n." & kin & " : " & kfi
End If
Scrivi " Situazione Frequenti nei colpi successivi all'estrazione del nr.spia ",1
'''''-'-------------------------------------------------------------------------------------------
For k = Inizio To Fine
If IndiceAnnualeDL(k) >= kin And IndiceAnnualeDL(k) <= kfi Then
'Scrivi k & " " & IndiceAnnuale(k) & "--" & kin & "--" & kfi
Call Messaggio(Format2(k) & " " & DataEstrazioneDL(k) & "  range orario:    " & kini & " : " & kfin)
For e = 1 To 20
nBase = EstrattoDL(k,e)
For c = 1 To EntroColpi
idEstr = k + c
For ee = 1 To 20
nUscito = EstrattoDL(idEstr,ee)
aPresenze(nBase,nUscito) = aPresenze(nBase,nUscito) + 1
Next
Next
Next
End If
Call AvanzamentoElab(Inizio,Fine,k)
If ScriptInterrotto Then Exit For
Next
'''''-'-------------------------------------------------------------------------------------------
If quanti < 11 Then
pt3 = quanti - 3
pt2 = quanti - 2
pt1 = quanti - 1
pt0 = quanti
Else
pt0 = 10
pt1 = 9
pt2 = 8
pt3 = 7
End If
ReDim aTitoli(10)
aTitoli(1) = "Numero Spia"
aTitoli(2) = "Numeri Piu Freq"
aTitoli(3) = "Uscite"
aTitoli(4) = "Frequenza"
aTitoli(5) = "% fav.Spia"
aTitoli(6) = "% fav.numeri Freq."
aTitoli(7) = "Punti" & pt3
aTitoli(8) = "Punti" & pt2
aTitoli(9) = "Punti" & pt1
aTitoli(10) = "Punti" & pt0
Call InitTabella(aTitoli,3,"center",1.5,1)
For nBase = 1 To 90
ReDim aValori(10)
aValori(1) = nBase
aValori(2) = GetNumeroPiuFreq(nBase,aPresenze,nUscite,quanti,Incrocio)
ReDim aV(0)
Call SplitByChar(aValori(2)," ",aV)
aValori(3) = nUscite
''''controlla presenze totali spia nel range di estrazioni
ReDim aN(1)
aN(1) = aValori(1)
Call StatisticaFormazioneDL(aN,1,RetRit,RetRitMax,0,RetFreq,Inizio,Fine)
presenzespia = RetFreq
''''controlla frequenze totali della quantità di numeri
ReDim aN(1)
aN(1) = aValori(2)
Call StatisticaFormazioneDL(aN,1,RetRit,RetRitMax,0,RetFreq,Inizio,Fine)
''''controlla frequenze totali della quantità di numeri
f = UBound(aV) - 1
ReDim aVn(f)
For e = 0 To f
aVn(e) = aV(e)
Next
aValori(7) = 0
aValori(8) = 0
aValori(9) = 0
aValori(10) = 0
fpt3 = SerieFreqDL(Inizio,Fine,aVn,pt3)
aValori(7) = fpt3
fpt2 = SerieFreqDL(Inizio,Fine,aVn,pt2)
aValori(8) = fpt2
fpt1 = SerieFreqDL(Inizio,Fine,aVn,pt1)
aValori(9) = fpt1
fpt0 = SerieFreqDL(Inizio,Fine,aVn,pt0)
aValori(10) = fpt0
aValori(4) = presenzespia
aValori(5) = Round(nUscite/totest*100,2)
If presenzespia > 0 Then aValori(6) = Round(nUscite/presenzespia*100,2)
Call AddRigaTabella(aValori)
If aValori(7) > 0 Then Call SetColoreCella(7,vbRed,vbWhite)
If aValori(8) > 0 Then Call SetColoreCella(8,vbGreen,vbBlack)
If aValori(9) > 0 Then Call SetColoreCella(9,vbYellow,vbBlack)
If aValori(10) > 0 Then Call SetColoreCella(10,vbYellow,vbBlack)
Next
Call SetTableWidth("100%")
Call CreaTabella
End Sub
Function GetNumeroPiuFreq(nBase,aPresenze,nUscite,quanti,Incrocio)
Dim k
ReDim aOrd(90,2)
nfre = ""
For k = 1 To 90
aOrd(k,1) = Format2(k)
aOrd(k,2) = aPresenze(nBase,k)
Next
Call OrdinaMatrice(aOrd,- 1,2)
For q = 1 To Int(quanti)
nfre = nfre & aOrd(q,1) & " "
tfre = tfre + aOrd(q,2)
Next
''
''' GetNumeroPiuFreq = aOrd(1,1)
GetNumeroPiuFreq = nfre
''''nUscite = aOrd(1,2)
nUscite = tfre
End Function

 

[solare]

Grazie ancora.
Comunque mi riferivo al gioco del lotto.

 

[Mike58]

CapoGico Scelto per le Ruote, abbinamenti migliori.

No Mesi.

'Option Explicit
Sub Main
   Dim aRetAbb,ru(1)
   Dim k,r
   n = InputBox("Quale Numero CapoGioco",,1)
   Scrivi "CapoGioco Scelto " & n,1,,,1,3,,1
   For r = 1 To 12 : If r = 11 Then r = 12
   Call Abbinamenti(n,aRetAbb,EstrazioneIni,EstrazioneFin,r,0)
        ru(1) = r
   For k = 1 To 10
      Scrivi n & "-" & Format2(aRetAbb(k,1)) & " con presenze " & aRetAbb(k,2)
      ReDim Preserve abb(k)
      abb(0) = n
      abb(k) = aRetAbb(k,1)

   Next
   Call VerificaEsito(abb,ru,EstrazioneFin,2,1,,esito,,es1)
   Scrivi SiglaRuota(r) & vbTab & StringaNumeri(abb),1
   If esito <> "" Then Scrivi es1,1,,,1
   If esito = "" Then Scrivi "Nessun Esito",,,,2
   Scrivi "============================================"
   Next
End Sub

 

[solare]

Grazie mille

 

[solare]

Ciao Mike58, nell'archivio che gentilmente mi hai modificato non aggiorna i numeri oro 1 e 2

 

[Mike58]

Non era stato citato andava messo su richiesta.

eccolo

Option Explicit
Sub Main
ImpostaArchivio10ELotto(1)
Dim Ini,Fin,IdEstr,P,nu(20),sChrSep,Oro,Oro2
sChrSep = ";"
Ini = EstrazioniArchivioDL-10
Fin = EstrazioniArchivioDL
Call ScegliRange(Ini,Fin,Ini,Fin)
Scrivi "Archivio 10 e Lotto Serale"
Scrivi "Estrazione inizio........... " & Ini
Scrivi "Estrazione fine............. " & Fin
Scrivi
Call ResetTimer
For IdEstr = Ini To Fin
For P = 1 To 20
nu(P) = EstrattoDL(IdEstr,P)
Next
Oro = NumeroOroDL(IdEstr)
Oro2 = Estratto(IdEstr,BA_,2)
Scrivi DataEstrazioneDL(IdEstr,,,"/") & sChrSep & FormattaStringa(IndiceAnnuale(IdEstr),"000") & sChrSep,1,0
Scrivi  StringaNumeri(nu,sChrSep,1),1,0,,1
Scrivi sChrSep & Format2 (Oro)& sChrSep & Oro2,1,,,2
Call AvanzamentoElab(Ini,Fin,IdEstr)
Next
Dim t:t = TempoTrascorso
If MsgBox("Vuoi visualizzare il tempo di elaborazioni dati?",4,"Opzione Output") = vbYes Then Scrivi : Scrivi t
End Sub

 

[solare]

Perfetto….ancora grazie infinite