Mike58

[trivellatomariotretre33]

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

 

[Mike58]

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

'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

 

[solare]

Ottima idea da parte di Trivellato.
Grazie Mike58

 

[trivellatomariotretre33]

grazie di cuore Mike58 sei un amicone ,
ti invio una stretta di mano chilometrica.
con stima ciao buona domenica-.

 

[antonioquagliozzi]

x mike 58 per scaricare lotto projectl.b dove posso trovare il ling

 

[Mike58]

prova qui
Qui

 

[antonioquagliozzi]

'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

qui

 

[antonioquagliozzi]

grazie mille