AMBI E TERNI PIU' FREQUENTI

[siriano]

Salve a tutti,
tempo fa avevo visto uno script con cui si potevano cercare gli ambi ed i terni più frequenti su 2 ruote contemporaneamente
in un certo arco di estrazioni, ho fatto una ricerca ma non sono riuscito a trovarlo, qualcuno può aiutarmi?
Grazie.

 

[cutoff]

.....usa spaziometria

 

[Alien.]

acc......ma sta cercando uno script.....se tu usi spaziometria...allora daglielo tu lo script............cavolacci.............

 

[cutoff]

Scusa Alien......ma con spaziometria ci vogliono 5 sec, perchè utilizzare uno script,cioè a dire, perchè inventarsi una ruota se gia esite? poi ognuno fa come crede...

 

[Joe91]

 

[siriano]

Cutoff secondo te uno che scrive in questo forum che programma usa per gli script? Forse "MarzianoinVisitaNotturna?"...

Joe91 grazie ma il tuo script cerca ambi ripetuti, io ho bisogno di cercare gli ambi più frequenti su 2 ruote in un certo arco di estrazioni.

 

[Joe91]

Ok ...

l'ho rimosso anche perchè ... mi sembra d'aver rilevato degli errori.

 

[Mike58]

Mio solo per Ambo

Sub Main

Dim k,kk

ReDim aValori(4005,1)

Dim n1,n2,nu(2)

Dim Rit,RitMax,Freq

Dim RuoteSelezionate

est = InputBox("QUANTE ESTRAZIONI ANALIZZO",,1000)

righe = CInt(InputBox("QUANTE RIGHE VISUALIZZO",,100))

freMin = CInt(InputBox("Quale Frequenza Minima",,7))

Ini = EstrazioneFin - est

fin = EstrazioneFin

Tot = fin - Ini

Scrivi" *** Ambi più Frequenti su Ruote Selezionate *** " & " ***** Script by Mike58 ******",1,1,3,0,4

ReDim ruota(12)

RuoteSelezionate = ScegliRuote(ruota)

For kk = 1 To RuoteSelezionate

Scrivi "Ruote selezionate : ",1,0

Scrivi NomeRuota(ruota(kk)) & " ",1,0,,2,3

Scrivi

Next

Call Scrivi("Range da " & GetInfoEstrazione(Ini) & " fino a " & GetInfoEstrazione(Fin),1,1)

Scrivi "Totali estrazioni esaminate... " & Tot,1,1,,1,3

Scrivi

ReDim T(13)

T(1) = " Ambo "

T(2) = " Freq "

T(3) = " Rit Att "

T(4) = " Rit.STo "

T(5) = " Ultimo esito "

T(6) = " data "

T(7) = " Incr Max "

T(8) = " Rp1 "

T(9) = " Rp2 "

T(10) = " Rp3 "

T(11) = " Rp4 "

T(12) = " Rp5 "

T(13) = " Media Rit "

Call InitTabella(T,2,,2,5,"arial black")

Call Messaggio("Statistica ambi")

For n1 = 1 To 89

For n2 = n1 + 1 To 90

k = k + 1

nu(1) = n1

nu(2) = n2

Call StatisticaFormazioneTurbo(nu,ruota,2,Rit,RitMax,Incr,Freq,Ini,Fin)

Call VerificaEsitoTurbo(nu,ruota,Fin - Rit,2,,,esito,colpi,estratti,Id)

'------- calcolo ritardi precedenti------------

ReDim rp(6)

InizioR = EstrazioneFin - 500

fineR = EstrazioneFin

somrit = 0

For z = 1 To 6

rp(z) = SerieRitardoTurbo(InizioR,fineR,nu,ruota,2)

fineR = fineR -(rp(z) + 1)

somrit = somrit + rp(z)

Medrit = Int(somrit/z)

Next

' fine calcolo----------------------------------

ReDim V(13)

V(1) = n1 & "." & n2

V(2) = Freq

V(3) = Rit

V(4) = RitMax

V(5) = estratti

V(6) = DataEstrazione(id) & " - [ " & id & " ] "

V(7) = Incr

V(8) = rp(2)

V(9) = rp(3)

V(10) = rp(4)

V(11) = rp(5)

V(12) = rp(6)

V(13) = Medrit

If Freq > freMin Then

Call AddRigaTabella(V,,,2,,"arial black")

If Incr > 0 Then Call SetColoreCella(1,3,1)

End If

If ScriptInterrotto Then Exit For

Next

If ScriptInterrotto Then Exit For

Call AvanzamentoElab(1,89,n1)

Next

'Call CreaTabella(2,,,righe)

scegliTabella

End Sub

Function scegliTabella()

ReDim Voci(2)

Voci(1) = "Tabella Normale"

Voci(2) = "tabella Ordinabile"

scegliTabella = ScegliOpzioneMenu(Voci,02,"seleziona tabella")

If scegliTabella = 1 Then Call CreaTabella(2,,,righe)

If scegliTabella = 2 Then Call CreaTabellaOrdinabile(2)

End Function

LuigiB per ambo e terno

Option Explicit

Sub Main

Dim nClasse

Dim nGaranzia

Dim k,j

Dim sNumeri

Dim idComb

Dim nInizio,nFine

Dim idValoreDaAna

Dim sValoreUsato

Dim CombTot

Dim aRuote

ReDim aCombMigliori(100,4)

nClasse = ScegliClasse

Call ScegliRuote(aRuote)

nGaranzia = ScegliGaranzia

idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)

nInizio = EstrazioneFin-1000

nFine = EstrazioneFin

If nClasse > 0 And nGaranzia > 0 And nGaranzia <= nClasse And idValoreDaAna > 0 Then

Call Messaggio("Sviluppo combinazioni di classe " & nClasse)

CombTot = InitSviluppaComb(nClasse)

Call Messaggio("Statistica combinazioni in corso ")

ReDim aCol(nClasse)

Do While GetCombSviluppo(aCol) = True

Call AnalisiComb(aCol,aRuote,nGaranzia,aCombMigliori,nInizio,nFine,idValoreDaAna)

k = k + 1

If k Mod 20 = 0 Then

Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)

Call AvanzamentoElab(1,CombTot,k)

If ScriptInterrotto Then Exit Do

End If

Loop

Call Messaggio("")

ReDim aTitoli(4)

aTitoli(1) = "Combinazione"

aTitoli(2) = "Frequenza"

aTitoli(3) = "Ritardo"

aTitoli(4) = "RitardoMax"

Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nGaranzia & " sulle ruote " & GetRuoteUsate(aRuote))

Call Scrivi("La seguente lista mostra le prime 100 combinazioni in base al valore di " & sValoreUsato)

Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))

Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)

Call Scrivi

Call InitTabella(aTitoli)

For k = 1 To UBound(aCombMigliori)

ReDim ADati(4)

ADati(1) = aCombMigliori(k,4)

ADati(2) = aCombMigliori(k,1)

ADati(3) = aCombMigliori(k,2)

ADati(4) = aCombMigliori(k,3)

Call AddRigaTabella(ADati)

Next

Call CreaTabella

Else

MsgBox "Selezionare la classe di sviluppo e la garanzia , " & _

"si ricorda che la garanzia non puo essere maggiore della classe di sviluppo " & _

"e che bisogna scegliere quale valore statistico considerare per " & _

"alimentare la lista delle prime 100 Combinazioni "

End If

End Sub

Sub AnalisiComb(aNum,aRuote,Garanzia,aCombMig,nInizio,nFine,idValoreDaAna)

Dim k,j

Dim Rit

Dim RitMax

Dim Freq

Dim Valore

Call StatisticaFormazione(aNum,aRuote,Garanzia,Rit,RitMax,0,Freq,nInizio,nFine)

Select Case idValoreDaAna

Case 1

Valore = Freq

Case 2

Valore = Rit

Case 3

Valore = RitMax

End Select

For k = 1 To UBound(aCombMig)

If Valore >= aCombMig(k,0) Then

For j = UBound(aCombMig) To(k + 1) Step - 1

aCombMig(j,0) = aCombMig(j - 1,0)

aCombMig(j,1) = aCombMig(j - 1,1)

aCombMig(j,2) = aCombMig(j - 1,2)

aCombMig(j,3) = aCombMig(j - 1,3)

aCombMig(j,4) = aCombMig(j - 1,4)

Next

aCombMig(k,0) = Valore

aCombMig(k,1) = Freq

aCombMig(k,2) = Rit

aCombMig(k,3) = RitMax

aCombMig(k,4) = StringaNumeri(aNum)

Exit For

End If

Next

End Sub

Function InitSviluppaComb(Classe)

Dim k

ReDim aNum(90)

For k = 1 To 90

aNum(k) = k

Next

InitSviluppaComb = InitSviluppoIntegrale(aNum,Classe)

End Function

Function ScegliClasse()

ReDim aVoci(3)

aVoci(0) = "Estratto"

aVoci(1) = "Ambo"

aVoci(2) = "Terno"

aVoci(3) = "Quaterna"

ScegliClasse = ScegliOpzioneMenu(aVoci,2,"Secegli tipo combinazione") + 1

End Function

Function ScegliGaranzia()

ReDim aVoci(3)

aVoci(0) = "Estratto"

aVoci(1) = "Ambo"

aVoci(2) = "Terno"

aVoci(3) = "Quaterna"

ScegliGaranzia = ScegliOpzioneMenu(aVoci,2,"Secegli garanzia") + 1

End Function

Function ScegliValoreDaAnalizzare(sValore)

ReDim aVoci(2)

Dim i

aVoci(0) = "Frequenza"

aVoci(1) = "Ritardo"

aVoci(2) = "Ritardo massimo"

i = ScegliOpzioneMenu(aVoci,0,"Quale valore considerare per l'ordinamento ? ")

sValore = aVoci(i)

ScegliValoreDaAnalizzare = i + 1

End Function

Function GetRuoteUsate(aRuote)

Dim k

Dim s

For k = 1 To UBound(aRuote)

s = s & SiglaRuota(aRuote(k)) & " "

Next

GetRuoteUsate = Trim(s)

End Function

 

[siriano]

Grazie Mike è quello che mi serviva.
Saluti

 

[antonino]

" & _ mi dà errore di script; come si corregge? grazie. nino

 

[antonino]

Ho dimenticato di indicare che l'errore è dato su spaziometria, ed è errore di linguaggio.
grazie,

nino

 

[antonino]

Scusa siriano, come fai ad aprirlo con spaziometria, se a me dà errore di sintassi?- appena lanciato?
grazie, nino

 

[Mike58]

A volte capita che copiato lo script dal forum perde la formattazione e allarga alcuni caratteri di congiunzione vedi &_.
Per ovviare a questo una volta copiato lo script fare sempre la formattazione automatica con l'apposito tasto icona Formattazione automatica e lo script verrà allineato in tutti i suoi punti e cosi pronto da eseguirsi senza errori.

Sono ancora in vacanza e posso solo scrivere a volte !!!


Ciao a tutti.

 

[solare]

Grazie anche da parte mia Mike58