Ciao amici sono da poco qui ma molto interessato ai vostri studi e ricerche sulla determinazione dei numeri buoni da giocare........uno ci prova......sperando che poi la dea bendata.........
E visto il desiderio e l'interesse........ mio ciao Angie,
spero che qualcuno adatti lo script.
grazie Ouram per l'utilissimo listato, io riesco ad aprirlo
come te........ del listato Quadro esteso dei numeri ripetuti x n volte su ruota unica ho fatto richiesta al buon Luigi di metterci mano e lui lo ha corretto.....
Pensando di far cosa gradita ho fatto un copia incolla anche qui dove ho visto per la prima volta lo script che dava problemi.....
SCRIPT ADATTATO
Option Explicit
Sub Main()
'rif. 0902_83a Ro - Ripetuti sul quadro esteso - a ruota
'visualizza il quadro esteso con colorazione dei numeri ripetuti in una frequenza scelta
Dim Vet(),stat(),temp(),nu(),max(12)
Dim fin,estr,Ini,r,es,f,n,p,x,y,i,cu,maxcu,co,riga,rigo,t,u,cl,m,s
Dim sTmpRiga , nTmpColor
fin = EstrazioneFin -(InputBox("Quante es vuoi andare indietro rispetto a Estrazionefin?",,100))
estr = InputBox("Su quante estrazioni vuoi cercare i ripetuti?",,12)
f = CInt(InputBox("Quale frequenza devono avere i ripetuti?",,2)) 'se vuoi con freq maggiori metti l'apice
' davanti a f e sostituisci la riga dove tovi questo segno<<<<<<<<<<<<<<<
Ini = fin -(estr - 1)
ReDim vet(0)
ReDim stat(2,0)
ReDim temp(0)
ReDim nu(12,0)
For r = 1 To 12
If r <> 11 Then nu(r,0) = r
Next
'-----------------------------
For r = 1 To 11
If r = 11 Then r = 12
Erase vet
Erase stat
ReDim vet(estr*5)
n = 0
For es = Ini To fin
For p = 1 To 5
n = n + 1
vet
= Estratto(es,r,p)
Next
Next
'------------------------
OrdinaMatrice vet,1
x = UBound(vet)
ReDim stat(2,0)
For i = 1 To x
If vet(i) > vet(i - 1) Then
co = co + 1
ReDim Preserve stat(2,co)
stat(1,co) = vet(i)
stat(2,co) = 1
For y = i + 1 To x
If vet(i) = vet
Then stat(2,co) = stat(2,co) + 1
Next
End If
Next
'------------------------
cu = 0
ReDim temp(0)
For i = 1 To co
If stat(2,i) = 2 Then ' <<<<<<<<<< sostituisci con questa If stat(2,i)=> 2 Then
cu = cu + 1
ReDim Preserve temp(cu)
If cu > maxcu Then maxcu = cu
temp(cu) = stat(1,i)
End If
Next
max(r) = cu
ReDim Preserve nu(12,maxcu)
For i = 1 To cu
nu(r,i) = temp(i)
Next
Next
'--------------------------------------
Scrivi Chr(10) & " QUADRO ESTESO DEI NUMERI RIPETUTI ",1,0
ColoreTesto 2
Scrivi "--> " & f & " <-- ",1,0
ColoreTesto 0
Scrivi " VOLTE SU RUOTA UNICA " & Chr(10),1
Scrivi Space(4) & "Ru - Ripetuti ",1
riga = FormattaTesto("Data",Space(10),2)
For r = 1 To 12
'If max(r) > 0 Then riga = riga & Space(6) & SiglaRuota(r) & Space(7)
If max(r) > 0 Then riga = riga & FormattaTesto(SiglaRuota(r),Space(15),2)
rigo = ""
If max(r) > 0 Then
rigo = Space(4) & SiglaRuota(nu(r,0)) & Space(2)
For t = 1 To max(r)
rigo = rigo & " " & Format2(nu(r,t))
Next
u = u + 1
End If
If rigo <> "" Then Scrivi rigo
Next
If u > 0 Then
Scrivi
Scrivi riga,1
For es = Ini To fin
'ColoreTesto 0
'Call Scrivi(DataEstrazione(es),0,0)
sTmpRiga = DataEstrazione(es)
For r = 1 To 11
If r = 11 Then
r = 12
End If
If max(r) > 0 Then
'ColoreTesto 0
'Scrivi "|",0,0
sTmpRiga = sTmpRiga & "|"
If Not pari(r) Or r = 12 Then
cl = "#FF0000" ' rosso
Else
cl = "#0000FF" ' blue
End If
For p = 1 To 5
For m = 1 To max(r)
'ColoreTesto 0
nTmpColor ="#000000"
If Estratto(es,r,p) = nu(r,m) Then
'ColoreTesto cl
nTmpColor = cl
Exit For
End If
Next
If p < 5 Then s = " " Else s = ""
sTmpRiga = sTmpRiga & GetTestoColorato (Format2(Estratto(es,r,p)) , nTmpColor ) & s
'Call Scrivi(Format2(Estratto(es,r,p)) & s,1,0)
