Novità

Mike58

trivellatomariotretre33

Super Member >PLATINUM<
Mike58 lo so che forse ti chiederai che strano che ti richiedo ancora una lecita Modifica a questo script ,
come tu vuoi valutalo e dopo magari decidi,se puoi .
ti metto il listato
e la modifica , che ti chiedo e questa ........
(solo al numero di ricerca di inserire ID MENSILE) E il resto va bene.
mi auguro in un tuo esito positivo per la mia richiesta .





'Option Explicit
Sub Main()
Dim Num,R,Estr,Es,P,E,x,k,freq(90)
Dim Nu(1),Ru(1),casi,vetN,VetQ
Num = CInt(InputBox("Quale Numero Cercare ",,77))
Estr = CInt(InputBox("Quante estrazioni",,400))
casi = CInt(InputBox("Quanti casi Visualizzo",,5))
Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA SOLARE - SCRIPT Salvo50" & Space(14),1,,4,,3,,1
Nu(1) = Num
For R = 1 To 12
If R = 11 Then R = 12
Scrivi String(53,"x") & " " & NomeRuota(R),1,,,1
For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1
Ru(1) = R
If SerieFreq(Es,Es,Nu,Ru,1) = 1 Then
k = k + 1 ' conteggio i casi
If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti
Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R) & " ",1,0
For P = 1 To 5
E = Estratto(Es,R,P)
If E = Num Then
ColoreTesto 2
Else
ColoreTesto 0
End If
If EstrattoFrequenza(R,E,EstrazioneFin - Estr,EstrazioneFin) > 1 Then
kk = kk + 1
ReDim Preserve aNum(kk)
aNum(kk) = E
End If
Scrivi Format2(E) & " ",1,0
ColoreTesto 0
Next
'--------------------------------------
Scrivi vbTab & k,1,0
Scrivi
End If
Next
'Scrivi StringaNumeri(aNum)
Call NumeriRipetutiRilevatiV(aNum,vetN,VetQ)
Scrivi " Numeri Ripetuti Rilevati................................... " & StringaNumeri(vetN,,1),1
Scrivi " Quantità numeri Rilevati................................... " & StringaNumeri(VetQ,,1)
kk = 0
k = 0
Next
End Sub
 
ok Trivellato eccolo con indice Mensile.
Lo sai che non amo mettere le mani più volte nelle modifiche script ma essendo solo una riga di codice posso sorvolare.

ciao


Codice:
'Option Explicit
Sub Main()
Dim Num,R,Estr,Es,P,E,x,k,freq(90)
Dim Nu(1),Ru(1),casi,vetN,VetQ
Num = CInt(InputBox("Quale Numero Cercare ",,77))
Estr = CInt(InputBox("Quante estrazioni",,800))
casi = CInt(InputBox("Quanti casi Visualizzo",,5))
id = CInt(InputBox("Quale indice mensile analizzo",,1))
 
Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA TRIVELLATO - SOLARE - SCRIPT Salvo50 _ Mike58" & Space(14),1,,4,,3,,1
Scrivi "Filtro IndiceMensile = " & id
Scrivi "Filtro Casi Max      = " & casi
Nu(1) = Num
For R = 1 To 12
If R = 11 Then R = 12
Scrivi String(53,"x") & " " & NomeRuota(R),1,,,1
For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1
Ru(1) = R
If SerieFreq(Es,Es,Nu,Ru,1) = 1 And IndiceMensile(Es) = id Then
k = k + 1 ' conteggio i casi
If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti
Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R) & " ",1,0
For P = 1 To 5
E = Estratto(Es,R,P)
If E = Num Then
ColoreTesto 2
Else
ColoreTesto 0
End If
If EstrattoFrequenza(R,E,EstrazioneFin - Estr,EstrazioneFin) > 1 Then
kk = kk + 1
ReDim Preserve aNum(kk)
aNum(kk) = E
End If
Scrivi Format2(E) & " ",1,0
ColoreTesto 0
Next
'--------------------------------------
Scrivi vbTab & k,1,0
Scrivi
End If
Next
'Scrivi StringaNumeri(aNum)
Call NumeriRipetutiRilevatiV(aNum,vetN,VetQ)
Scrivi " Numeri Ripetuti Rilevati................................... " & StringaNumeri(vetN,,1),1
Scrivi " Quantità numeri Rilevati................................... " & StringaNumeri(VetQ,,1)
kk = 0
k = 0
Next
End Sub
 
'Option Explicit Sub Main() Dim Num,R,Estr,Es,P,E,x,k,freq(90) Dim Nu(1),Ru(1),casi,vetN,VetQ Num = CInt(InputBox("Quale Numero Cercare ",,77)) Estr = CInt(InputBox mi("Quante estrazioni",,800)) casi = CInt(InputBox("Quanti casi Visualizzo",,5)) id = CInt(InputBox("Quale indice mensile analizzo",,1)) Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA TRIVELLATO - SOLARE - SCRIPT Salvo50 _ Mike58" & Space(14),1,,4,,3,,1 Scrivi "Filtro IndiceMensile = " & id Scrivi "Filtro Casi M ilax = " & casi Nu(1) = Num For R = 1 To 12 If R = 11 Then R = 12 Scrivi String(53,"x") & " " & NomeRuota(R),1,,,1 For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1 Ru(1) = R If SerieFreq(Es,Es,Nu,Ru,1) = 1 And IndiceMensile(Es) = id Then k = k + 1 ' conteggio i casi If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0 Scrivi " " & SiglaRuota(R) & " ",1,0 For P = 1 To 5 E = Estratto(Es,R,P) If E = Num Then ColoreTesto 2 Else ColoreTesto 0 End If If EstrattoFrequenza(R,E,EstrazioneFin - Estr,EstrazioneFin) > 1 Then kk = kk + 1 ReDim Preserve aNum(kk) aNum(kk) = E End If Scrivi Format2(E) & " ",1,0 ColoreTesto 0 Next '-------------------------------------- Scrivi vbTab & k,1,0 Scrivi End If Next 'Scrivi StringaNumeri(aNum) Call NumeriRipetutiRilevatiV(aNum,vetN,VetQ) Scrivi " Numeri Ripetuti Rilevati................................... " & StringaNumeri(vetN,,1),1 Scrivi " Quantità numeri Rilevati................................... " & StringaNumeri(VetQ,,1) kk = 0 k = 0 Next End Sub

 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 12 luglio 2025
    Bari
    67
    30
    66
    89
    47
    Cagliari
    06
    66
    33
    32
    37
    Firenze
    43
    25
    78
    21
    23
    Genova
    34
    20
    85
    52
    33
    Milano
    36
    19
    02
    70
    77
    Napoli
    21
    72
    74
    15
    53
    Palermo
    32
    08
    37
    02
    86
    Roma
    27
    32
    12
    67
    06
    Torino
    45
    47
    08
    13
    32
    Venezia
    29
    34
    19
    51
    53
    Nazionale
    34
    18
    56
    47
    85
    Estrazione Simbolotto
    Nazionale
    02
    26
    01
    08
    17

Ultimi Messaggi

Indietro
Alto