LA SUPER FREQUENZA

roy

io ho questo listato , vedi se può servirti ,
cosi' controlla le ultime 9 estrazioni ,
ma puoi cambiarle tu come pure la ruota

Codice:


Sub main()
Dim nu(1), ru(1)
ru(1)=InputBox("qual'è la ruota","ruota di verifica",12)
ini  =InputBox("da quale estrazione","da quale estrazione",8940)
fin  =EstrazioneFin
ColoreTesto 2
Scrivi "Verifica sulla ruota di "&NomeRuota(ru(1)),1
Scrivi "Periodo verifica : " & (fin-ini)+1 & " estrazioni",1
Scrivi "Da "&DataEstrazione(ini,1) &" a "&dataEstrazione(fin,1),1
ColoreTesto 1:scrivi
Scrivi "       Numeri         Ripetizioni " ,1
ColoreTesto 0
For x=1 To 90
nu(1)=x
rp=SerieFreq(ini,fin,nu,ru,1)-1
If rp>0 Then
Scrivi Space(9) & Format2(x) & Space(15) & rp,1
End If : Next : End Sub



grazie franca,lo provo....grazie

ciao FRANCA,no non è questo quello che cerco,a me non interessa la statistica,ma ogni volta che in un periodo di ricerca ci sia un'evento di un numero con super frequenza (3 o 4 tramite inputbox compresa in 5 estrazioni)...individuarlo e poi mettere la giocata,di ambata,ambo ecc....provo a pasticciare un pò,ma non sono così bravo....
grazie comunque..ciao

Parere personale:

Ti posso dire che è tempo perso....  ho già provato e riprovato questa cosa
devi modificare alcuni parametri...
3/4 frequenze sono difficilissime da trovare, e anche inutili
prendi 10/15 numeri + frequenti in tot estrazioni
e dividili in ambi, da li analizzi i + fre e i + rit
e giochi quest'ultimi
lo script che chiedi all'inizio non è facilissimo da realizzare
ma quello che ti ho appena detto,è facile
anche se non controlla le giocate (le fai tu mettendo in gioco gli ambi)
ciao

grazie black x l'interessamento.....

...ma ho trovato dei riscontri positivi...su quel tipo di frequenza....

...mi facilitava tantissimo il tipo di ricerca.....e l'individuazione delle giocata....ciao e grazie

certo, il mio è un parere personale
quindi  se ti da riscontri positivi, prosegui...
per aggiungere la giocata devi mettere un contatore
e altre menate non semplicissime per i meno esperti (me compreso)
pero' puoi controllare a mano le uscite
la cosa primaria è avere lo script che ti dia le frequenze richieste
e questo penso tu sia in in grado di farlo
ciao

ciao a tutti ho provato a modificare lo script di franca46 e ho ottenuto il risultato che secondo me (a quanto ho capito ), che cerca il nostro amico roy62.
Sub Main()
Dim nu(1), ru(1)
fin =InputBox("ultima estrazione","da quale estrazione",8940)
ini = Fin - 4

ColoreTesto 2
For cc = 1 To 10
ru(1) = cc
Scrivi "Verifica sulla ruota di "&NomeRuota(ru(1)),1
Scrivi "Periodo verifica : " & (fin-ini)+1 & " estrazioni",1
Scrivi "Da "&DataEstrazione(ini,1) &" a "&DataEstrazione(fin,1),1
ColoreTesto 1:Scrivi
Scrivi " Numeri Ripetizioni " ,1
ColoreTesto 0
For x=1 To 90
nu(1)=x
rp=SerieFreq(ini,fin,nu,ru,1)
If rp => 2 Then
Scrivi Space(9) & Format2(x) & Space(15) & rp,1
End If : Next :Next: End Sub

GRAZIE SCARDEC DELL'IMPEGNO MA HO TROVATO UNO SCRIPT SU SPAZIO + DETTAGLIATO CHE POSTO SPERANDO DI FARE COSA GRADITA

Codice:

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(n) = 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(y) 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)
            Next
            'If r = 12 And p = 6 Or r = u And p = 6 Then Scrivi Chr(13)
            'If r = 12 And p = 6  Then Scrivi Chr(13)
         End If
      Next
      Call Scrivi(sTmpRiga)
      
      
   Next
End If
ColoreTesto 2
If u = 0 Then Scrivi Chr(10) & " Nessun ripetuto con i parametri impostati "
If u > 0 And u < 11 Then
   Scrivi Chr(10) & "NB: le ruote prive di " & f & " ripetuti, non vengono visualizzate"
End If
End Sub
Function FormattaTesto(sValue,sFmt,nAllineamento)
   ' nAllineamento
   ' 0 = allinea a sinistra
   ' 1 = allinea a destra
   ' 2 = allinea  al centro
   
   Dim k
   Dim nSpSx,nSpDx,nLen
   
   If sValue <> "" Then
      If Len(sFmt) > Len(sValue) Then
         If nAllineamento = 0 Then
            FormattaTesto = sValue & Mid(sFmt,Len(sValue) + 1)
         ElseIf nAllineamento = 1 Then
            FormattaTesto = Mid(sFmt,1,Len(sFmt) - Len(sValue)) & sValue
         ElseIf nAllineamento = 2 Then
            
               nLen = Len(sFmt) - Len(sValue)
               If nLen Mod 2 = 0 Then
                  nSpSx = nLen/2
                  nSpDx = nLen/2
               Else
                  nSpSx = nLen\2
                  nSpDx = nSpSx + 1
               End If
               FormattaTesto = Space(nSpSx) & sValue & Space(nSpDx)
            
         End If
      Else
         FormattaTesto = sValue
      End If
   Else
      FormattaTesto = sFmt
   End If
End Function

Function GetTestoColorato(sTesto,colore)
   GetTestoColorato = "<font color =" & colore & ">" & sTesto & "</font>"
   

End Function



ottimo ho intenzione di usarlo anch'io e questo è veramente quello che volevo. grazie e ciao