Gentilmente una modifica

[janez57]

Buon giorno a tutti/e
Avrei bisogno gentilmente di questo script modificarlo in due soluzioni:
1)Mettere in prima posizione il numero più uscito a scalare fino in ultima
posizione meno uscito.
Soluzione 2)Una volta fatto questo eventualmente in un secondo script
stesse condizioni però farlo fermare alla prima uscita di un un numero
sempre in prima posizione il più uscito a scalare fino al meno uscito.
Grazie mille a chi può soddisfare la mia richiesta.
Janez

'frequenza numeri nei Mesi a scelta
Sub Main()
Dim x(90)

' Anno 2000 - 6877-6981 \/ Anno 2001 - 6982-7086 \/ Anno 2002 - 7087-7195 \/ Anno 2003 - 7196-----
r = InputBox("Inserisci la ruota di ricerca","RUOTA",1)
kk = CInt(InputBox("Inserisci mese di ricerca","MESE",1))
An1 = CInt(InputBox("Inserisci INIZIO ANNO di ricerca","ANNO",2009))
An2 = CInt(InputBox("Inserisci FINE ANNO di ricerca","ANNO",2018))
ini = 1'CInt(InputBox("Inizio ricerca","DA ESTRAZIONE N,",EstrazioneFin-1560))
fin = EstrazioneFin'CInt(InputBox("FINE ricerca","FINE ESTRAZIONE N,",EstrazioneFin))
For a = 1 To 90
x(a) = 0
Next
For n = ini To fin
If Mese=kk And Anno=>An1 And Anno=<An2 Then
'For r=1 To 10
For e = 1 To 5
n1 = Estratto(n,r,e)
x(n1) = x(n1) + 1
Next
'Next
End If
Next
'Scrivi " Quantità per ogni numero estratto DA ESTRAZIONE N." & ini &" FINO ALL'ESTRAZIONE N." & fin &" sulla ruota di "&NomeRuota(r)&" nel MESE di "&MeseNome(kk),1
Scrivi " Quantità per ogni numero estratto DA ANNO N." & An1 & " FINO ANNO N." & aN2 & " sulla ruota di " & NomeRuota(r) & " nel MESE di " & MeseNome(kk),1
For i = 1 To 90
s = CStr(eval(i)) + " " + CStr(eval(x(i)))
Scrivi s
Next
End Sub

 

[Mike58]

Messo in Tabella è ordinato x presenza.

Sub Main()
Dim x(90)

' Anno 2000 - 6877-6981 \/ Anno 2001 - 6982-7086 \/ Anno 2002 - 7087-7195 \/ Anno 2003 - 7196-----
r = InputBox("Inserisci la ruota di ricerca","RUOTA",1)
kk = CInt(InputBox("Inserisci mese di ricerca","MESE",1))
An1 = CInt(InputBox("Inserisci INIZIO ANNO di ricerca","ANNO",2009))
An2 = CInt(InputBox("Inserisci FINE ANNO di ricerca","ANNO",2018))
ini = 1'CInt(InputBox("Inizio ricerca","DA ESTRAZIONE N,",EstrazioneFin-1560))
fin = EstrazioneFin'CInt(InputBox("FINE ricerca","FINE ESTRAZIONE N,",EstrazioneFin))
T = Array(T,"Numero","Presenza")
Call InitTabella(T)
For a = 1 To 90
x(a) = 0
Next
For n = ini To fin
If Mese(n)=kk And Anno(n)=>An1 And Anno(n)=<An2 Then
'For r=1 To 10
For e = 1 To 5
n1 = Estratto(n,r,e)
x(n1) = x(n1) + 1
Next
'Next
End If
Next
'Scrivi " Quantità per ogni numero estratto DA ESTRAZIONE N." & ini &" FINO ALL'ESTRAZIONE N." & fin &" sulla ruota di "&NomeRuota(r)&" nel MESE di "&MeseNome(kk),1
Scrivi " Quantità per ogni numero estratto DA ANNO N." & An1 & " FINO ANNO N." & aN2 & " sulla ruota di " & NomeRuota(r) & " nel MESE di " & MeseNome(kk),1
For i = 1 To 90
's = CStr(eval(i)) + " " + CStr(eval(x(i)))
'Call OrdinaMatrice(x,-1-1)
'Scrivi s
V = Array(V,i,x(i))
Call AddRigaTabella(V)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      
Next
Call CreaTabella(2)
End Sub

Ma il mio pur essendo rigido con inizio 2010 è molto + dettagliato.

Sub Main()
   Dim nua(4005,16),nn(2)
   'ee = DataEstrToIdEstr (31,12,2009)

   ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2009")
   ms = CInt(InputBox("In quale mese? ",,1))
   If ms = "" Then Exit Sub
   'r = CInt(InputBox("Di quale ruota? ",,5))
   'If r = "" Then Exit Sub
   'ru(1) = r
   q = CInt(InputBox("Quanti ambi ed estratti vuoi visualizzare ? ",,20))
   If q = "" Then Exit Sub
   '
   ReDim ru(0)
   r = ScegliRuote(ru)
   fin = EstrazioneFin
   ResetTimer
   '------------init tabella ------------------
   ReDim atitoli(15)
   atitoli(1) = " "
   atitoli(2) = " Numero "
   atitoli(3) = " Frequenza "
   atitoli(4) = " Ritardo Attuale "
   atitoli(5) = " Anno_2016 "
   atitoli(6) = " Anno_2015 "
   atitoli(7) = " Anno 2014 "
   atitoli(8) = " Anno 2013 "
   atitoli(9) = " Anno 2012 "
   atitoli(10) = " Anno 2011 "
   atitoli(11) = " Anno 2010 "
   atitoli(12) = " Anno 2017 "
   atitoli(13) = " Anno 2018 "
   atitoli(14) = " Rit Sto "
   atitoli(15) = " "
   Call InitTabella(atitoli,1,,3,5)
   For es = PrimaSuccessiva(ee) To fin
      If Mese(es) = ms Then
         co = 0
         'For x = 1 To 89
         'x = cg
         'For y = x + 1 To 90
         For x = 1 To 90
            'If x <> y Then
            co = co + 1
            nua(co,1) = co
            nua(co,2) = x
            'nua(co,3) = y
            nn(1) = x
            'nn(2) = y
            k = SerieFreqTurbo(es,es,nn,ru,1)
            rt = SerieRitardoTurbo(Ini,fin,nn,ru,1)
            rs = SerieStoricoTurbo(Ini,fin,nn,ru,1)
            nua(co,4) = nua(co,4) + k
            nua(co,5) = rt
            nua(co,15) = rs
            k1 = 0
            If Anno(es) = 2016 Then k1 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,6) = nua(co,6) + k1
            k2 = 0
            If Anno(es) = 2015 Then k2 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,7) = nua(co,7) + k2
            k3 = 0
            If Anno(es) = 2014 Then k3 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,8) = nua(co,8) + k3
            k4 = 0
            If Anno(es) = 2013 Then k4 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,9) = nua(co,9) + k4
            k5 = 0
            If Anno(es) = 2012 Then k5 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,10) = nua(co,10) + k5
            k6 = 0
            If Anno(es) = 2011 Then k6 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,11) = nua(co,11) + k6
            k7 = 0
            If Anno(es) = 2010 Then k7 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,12) = nua(co,12) + k7
            k8 = 0
            If Anno(es) = 2017 Then k8 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,13) = nua(co,13) + k8
            k9 = 0
            If Anno(es) = 2018 Then k9 = SerieFreqTurbo(es,es,nn,ru,1)
            nua(co,14) = nua(co,14) + k9


         Next
         'Next
      End If
   Next
   OrdinaMatrice nua,- 1,4
   ColoreTesto 2
   Scrivi Space(10) & "Dal " & ee & " al " & DataEstrazione(fin),1
   ColoreTesto 0
   Scrivi "I " & q & " Numeri più frequenti " & " a " & StringaRuote(ru) & " nel mese di " & MeseNome(ms),1
   Scrivi
   For z = 1 To q
      ReDim avalori(15)
      avalori(1) = "  "
      avalori(2) = nua(z,2)
      avalori(3) = nua(z,4)
      avalori(4) = nua(z,5)
      avalori(5) = nua(z,6)
      avalori(6) = nua(z,7)
      avalori(7) = nua(z,8)
      avalori(8) = nua(z,9)
      avalori(9) = nua(z,10)
      avalori(10) = nua(z,11)
      avalori(11) = nua(z,12)
      avalori(12) = nua(z,13)
      avalori(13) = nua(z,14)
      avalori(14) = nua(z,15)
      avalori(15) = " "
      Call AddRigaTabella(avalori,,,3)
      For xx = 5 To 12
         Call SetColoreCella((xx),4,1)

      If avalori(5) > 0 And avalori(6) > 0 And avalori(7) > 0 And avalori(8) > 0 And avalori(9) > 0 And avalori(10) > 0 And avalori(11) > 0 And avalori(12) > 0 Then
      Call SetColoreCella((xx),6,1)
      Call SetColoreCella(2,6,1)
      End If
      Next
      'If avalori(5) = 0 And avalori(6) > 0 And avalori(7) > 0 And avalori(8) > 0 And avalori(9) > 0 Then Call SetColoreCella(2,vbGreen)
      'If avalori(5) > 0 Then Call SetColoreCella(2,2,4)
      'If rit = 0 Then Call SetColoreCella(4,3,2)
      If avalori(4) = 0 Then Call SetColoreCella(4,3,2)
      Call SetColoreCella(1,1,0)
      Call SetColoreCella(15,1,0)
      k11 = k11 + avalori(5)
      k12 = k12 + avalori(6)
      k13 = k13 + avalori(7)
      k14 = k14 + avalori(8)
      k15 = k15 + avalori(9)
      k16 = k16 + avalori(10)
      k17 = k17 + avalori(11)
      k18 = k18 + avalori(12)
      k19 = k19 + avalori(13)
      'riga = Format2(nua(z,2)) & "-" & Format2(nua(z,3)) & Space(3) & Format2(nua(z,4)) & Space(10) & Format2(nua(z,5))
      'Scrivi Space(10) & riga,1
      'riga = ""
   Next
   ReDim avalori1(15)
   avalori1(1) = " "
   avalori1(5) = k11
   avalori1(6) = k12
   avalori1(7) = k13
   avalori1(8) = k14
   avalori1(9) = k15
   avalori1(10) = k16
   avalori1(11) = k17
   avalori1(12) = k18
   avalori1(13) = k19
   Call AddRigaTabella(avalori1,1,,3,5)
   Call SetTableWidth("100%")
   Call CreaTabella()
   Scrivi "Tempo di Elaborazione : " & TempoTrascorso
   Scrivi "     Tabella listed by Mike58      ",1,- 1,3
End Sub

mentre questo è una chicca di LuigiB x gli ambi

Option Explicit
Class ClsCombinazione
Private aNumeri
Private aRuote
Private m_ritardo
Private m_frequenza
Private m_ritardoMax
Private m_sorte
Private m_EstrIni
Private m_EstrFin
Public Property Get Ruote
Ruote = aRuote
End Property
Public Property Get Sorte
Sorte = m_sorte
End Property
Public Property Get EstrIni
EstrIni = m_EstrIni
End Property
Public Property Get EstrFin
EstrFin = m_EstrFin
End Property
Public Property Get Ritardo
Ritardo = m_ritardo
End Property
Public Property Get Frequenza
Frequenza = m_frequenza
End Property
Public Property Get RitardoMax
RitardoMax = m_ritardoMax
End Property
Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
Dim nColTot,r
ReDim aR(1)
aNumeri = vNumeri
aRuote = vRuote
m_sorte = Sorte
m_EstrIni = Inizio
m_EstrFin = Fine
m_ritardo = 0
m_frequenza = 0
m_ritardoMax = 0
Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m_ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_EstrFin)
End Sub
Function StringaNum
StringaNum = StringaNumeri(aNumeri)
End Function
End Class
Sub Main
Dim nQNum,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
Dim Coll,clsCmb
Dim R,j
Dim idTipoRic
ReDim aNumeri(0)
ReDim aVTable(11)
ReDim abMesi(12)
Dim aVTipoRic
aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
idMese = ScegliMese
abMesi(idMese) = True
nFisso = Sceglifisso
aVTable(1) = "Ruota"
ResetTimer

For R = 2 To 11
aVTable(R) = "A" & R - 1
Next
Call InitTabella(aVTable)
Inizio = 8163'EstrazioneIni
Fine = EstrazioneFin
nQNum = ScegliNumeri(aNumeri)
nSorte = ScegliEsito(2)
idTipoRic = ScegliTipoRicerca
nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
For R = 1 To 12
'If R <> 11 Then
aVTable(1) = NomeRuota(R)
Call Messaggio(aVTable(1))
Set Coll = GetNewCollection
Call EseguiStatistica(nFisso,aNumeri,R,nSorte,nSorte,Inizio,Fine,Coll)
Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
'For j = 2 To 11
For j = 2 To Coll.count + 1
If j > 11 Then Exit For
Set clsCmb = Coll(j - 1)
If aVTipoRic(idTipoRic) = "Frequenza" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
End If
Next
Call AddRigaTabella(aVTable)
'End If
Call AvanzamentoElab(1,12,R)
Next
SetTableWidth("100%")
Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Numero fisso     ; " & Iif(nFisso = 0,"Nessuno",nFisso))
Call Scrivi("Mese analizzato  : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
Call Scrivi("Estrazioni tot,  : " & nEstrAna)
Call Scrivi(String(100,"-"))
Call CreaTabella
Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1

End Sub
Sub EseguiStatistica(nFisso,vNumeri,nRuota,Classe,Sorte,Inizio,Fine,CollDest)
Dim nColTot
Dim cComb
ReDim aFissi(1)
aFissi(1) = nFisso
ReDim aR(1)
aR(1) = nRuota
If aFissi(1) > 0 Then
nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
Else
nColTot = InitSviluppoIntegrale(vNumeri,Classe)
End If
ReDim aCol(0)
Do While GetCombSviluppo(aCol)
Set cComb = New ClsCombinazione
Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
CollDest.Add cComb
Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
If aMesi(0) Then
MeseValido = True
Else
MeseValido = aMesi(Mese(idEstr))
End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
Dim k
Dim nValide,b
nValide = 0
For k = Inizio To fine
b = MeseValido(k,aMesi)
Call ImpostaEstrazione(k,CBool(b))
If b Then
nValide = nValide + 1
End If
Next
AttivaEstrazioni = nValide
End Function
Function ScegliMese
Dim aV
aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
ReDim aV(90)
Dim k
aV(0) = "Nessun fisso"
For k = 1 To 90
aV(k) = k
Next
Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
Dim aV
aV = Array("Frequenza","Ritardo","RitardoMax")
ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function

ciao

 

[janez57]

Buon pomeriggio a tutti/e

Grazie mille Sig.Mike58 è un qualcosa in più di quello che mi aspettavo.
Sempre Gentilissimo.
Janez

 

[janez57]

Buona sera a tutti/e

Gentilmente Sig. Mike58 è possibile nel secondo script

Ma il mio pur essendo rigido con inizio 2010 è molto + dettagliato
Bloccarlo alla prima vincita mensile di qualsiasi numero?
per avere una statistica più reale.
Grazie mille
Janez

 

[Mike58]

Ciao Janez, modificare uno script nato con uno scopo ben preciso in fatto di raccolta dati e output presentato , comporta sempre uno spreco inutile di energie, oltre che di modifica output.

Quello che vuoi vedere secondo me è rilevabile dal ritardo o dalla presenza nell'anno corrente.

Dai non posso proprio mofificarlo.

Ciao

 

[janez57]

Buon giorno a tutti/e

Grazie mille Sig.Mike58.
Pensavo fosse una modifica semplice.
Buona giornata.
Janez

 

[Mike58]

Ciao Janez, qualcosa è possibile tuttavia fare sul tuo script.
Vedi se cosi ti va bene

Sub Main()
Dim x(90),ru(1),nu(1)

' Anno 2000 - 6877-6981 \/ Anno 2001 - 6982-7086 \/ Anno 2002 - 7087-7195 \/ Anno 2003 - 7196-----
r = InputBox("Inserisci la ruota di ricerca","RUOTA",1)
kk = CInt(InputBox("Inserisci mese di ricerca","MESE",9))
An1 = CInt(InputBox("Inserisci INIZIO ANNO di ricerca","ANNO",2009))
An2 = CInt(InputBox("Inserisci FINE ANNO di ricerca","ANNO",2018))
ini = 1'CInt(InputBox("Inizio ricerca","DA ESTRAZIONE N,",EstrazioneFin-1560))
fin = EstrazioneFin'CInt(InputBox("FINE ricerca","FINE ESTRAZIONE N,",EstrazioneFin))
T = Array(T,"Numero","Presenza","Verifica Mese Corrente","ID Data","colpo","Ritardo")
Call InitTabella(T)
For a = 1 To 90
x(a) = 0
Next
For n = ini To fin
If Mese(n) = kk And Anno(n) >= An1 And Anno(n) <= An2 Then
'For r=1 To 10
ru(1) = r
For e = 1 To 5
n1 = Estratto(n,r,e)
x(n1) = x(n1) + 1
Next
'Next
End If
Next
'Scrivi " Quantità per ogni numero estratto DA ESTRAZIONE N." & ini &" FINO ALL'ESTRAZIONE N." & fin &" sulla ruota di "&NomeRuota(r)&" nel MESE di "&MeseNome(kk),1
Scrivi " Quantità per ogni numero estratto DA ANNO N." & An1 & " FINO ANNO N." & aN2 & " sulla ruota di " & NomeRuota(r) & " nel MESE di " & MeseNome(kk),1
For i = 1 To 90
nu(1) = i
's = CStr(eval(i)) + " " + CStr(eval(x(i)))
'Call OrdinaMatrice(x,-1-1)
'Scrivi
ess = 9520 ' id inizio settembre
Call VerificaEsito(nu,ru,ess,1,13,,,clp,es1,id)
er = EstrattoRitardo(r,i,1,fin)

If EstrattoFrequenza(r,i,ess,fin) > 0 Then
k = k + 1
ReDim Preserve aNum(k)
aNum(k) =  i
End If

V = Array(V,i,x(i),es1,GetInfoEstrazione(id),clp,er)
Call AddRigaTabella(V)
Next
Call CreaTabella(2)
Call Scrivi ("Numeri Sortiti Nel Mese corrente..... " & StringaNumeri(aNum) & "  ( " & k & " )",1,,,1,3)
End Sub

ess = 9520 ' id inizio settembre
chiaramente questa riga è stata messa in manuale e per altri mesi è necessario ri-modificarla per una corretta VerificaEsito.​

 

[janez57]

Buon pomeriggio a tutti/e

Troppo gentile Sig.Mike58
Grazie mille

Janez