non lo so, mettilo in chiaro,
sto con un pc non mio e ho blocchi limitatorii...
Option Explicit
Sub Main
Dim nInizio,nFine ' variabili che indicano i limiti del range analizzato
Dim k ' variabile di controllo per il ciclo che scorre le estrazioni da analizzare
Dim CollAmbiSommaA ' contenitore degli ambi trovati con somma 53 (s1)
Dim CollAmbiSommaB ' contenitore degli ambi trovati con somma 74 (s2)
Dim s1,s2 ' variabili delle somme da trovare per la condizione (s1 = somma A ) (s2 = somma B)
Dim clsAmboA,clsAmboB ' variabili per ciclare sui contenitori degli ambi trovati
'Dim RetEsito,RetColpi,RetEstratti,RetIdEstr ' parametri di ritorno per VerificaEsito
Dim nCasi,nCasiVincenti ' memorizza casi totali e casi vincenti
Dim sNumeriInteressati,sRuoteinteressate ' variabili che dinamicamente contengono i numeri degli ambi isotopi in somma
' ad ogni estrazione analizzzata se la condizione è stata trovata queste variabili contengono
' i numeri interessati e le ruote
Const nSorteMinima = 2 ' sorte minima di gioco ambo
Const nColpiMax = 12 ' colpi massimi di gioco 12
' preimposto le somme volute si fa all'inizio perche tanto non cambiano
s1 = 53
s2 = 74
' leggo il range da analizzare direttamente da quello impostato nel programma con la barra rosa
nInizio = EstrazioneIni
nFine = EstrazioneFin
' dimensiono un array che conterra i 13 numeri in gioco
ReDim aNumInGioco(13)
' lancio la procedura che effettivamente alimenta l'array dei numeri in gioco
Call AlimentaNumInGioco(aNumInGioco)
' faccio il ciclo sulle estrazioni del range da analizzare
For k = nInizio To nFine
' NOTA :
' lo spazioscript contiene numerose funzioni che agvolano il lavoro per lo scripter
' nel tuo caso dato che vuoi ottenere degli ambi isotopi di una certa somma
' puoi appunto usare la funzione apposita cosi eviti di dover scrivere da solo cicli nidificati
' che ti potrebbero confondere , la funzione è la seguente GetAmbiSommaX
' questa funzione cerca tutti gli ambi di una determinata somma in una determinata estrazione
' e li mette in un contenitore che poi si puo leggere
' lancio una prima volta la funzione per trovare gli ambi con somma A (53)
' tutti gli ambi trovati in tutte le ruote saranno inseriti nel contenitore
' CollAmbiSommaA
Call GetAmbiSommaX(k,CollAmbiSommaA,s1)
' lancio una seconda volta la funzione per trovare gli ambi con somma B (74)
' tutti gli ambi trovati in tutte le ruote saranno inseriti nel contenitore
' CollAmbiSommaB
Call GetAmbiSommaX(k,CollAmbiSommaB,s2)
' NOTA :
' in questo punto del codice i due contenitori CollAmbiSommaA e CollAmbiSommaB
' conterranno un certo numero di ambi trovati
' ora bisogna combinare gli ambi del contenitore A con quelli del contenitore B
' e poi verificare la faccenda dell'isotopia per vedere se la condizione è rispettata
' attraverso 2 cicli combino gli ambi di somma A con quelli di somma B
For Each clsAmboA In CollAmbiSommaA 'il ciclo for each è uguale al for next solo che usa una variabile oggetto
For Each clsAmboB In CollAmbiSommaB 'piuttosto che una numerica, percio si usa per ciclare gli oggetti in un contenitore
ReDim aRuote(2) ' array delel ruote interessate che usero per giocare se la condizione è valida
' lancio una funzione che si occupa di verificare la condizione
' se torna True vuol dire che la condizione richiesta è stata trovata
If CondizioneRispettata(clsAmboA,clsAmboB,aRuote,sNumeriInteressati) = True Then
' a questo punto la condizione è stata trovata
' incremento i casi trovati
nCasi = nCasi + 1
' scrivo comunque l'estrazione di rilevamento a prescindere dall'esito che si verifichera
Call Scrivi(String(80,"°") & " Caso n°" & nCasi,1)
Call Scrivi(DataEstrazione(k) & " - " & Left(clsAmboA.RuoteInteressate,3) & " - " & StringaEstratti(k,aRuote(1)) & " - " & Left(clsAmboB.RuoteInteressate,3) & " - " & StringaEstratti(k,aRuote(2)) & " - " & " AMBI SPIA BY BAFFOBLU: " & sNumeriInteressati)
' uso la funzione verificaEsito che tron a true se è capitato un esito maggiore o uguale a quello previsto entro i dati colpi
If Verifica(aNumInGioco,aRuote,k+1,nSorteMinima,nColpiMax, nCasiVincenti ) = False Then
' naturalmente bisogna scrivere anche quando non si è vinto
Call Scrivi("Esito negativo",,,vbRed ,vbWhite)
End If
'Call Scrivi(String(80,"°"),1)
End If
Next
Next
Call AvanzamentoElab(nInizio,nFine,k)
Next
' totali finali
Call Scrivi(String(50,"="))
Call Scrivi("Casi Totali : " & FormatSpace(nCasi,10,True))
Call Scrivi("Casi Vincenti : " & FormatSpace(nCasiVincenti,10,True) & " (" & Round(ProporzioneX(nCasiVincenti,nCasi,100),3) & "%)")
End Sub
Function CondizioneRispettata(clsAmboA,clsAmboB,aRuote,sNumeri)
' questa funzione serve a verificare la condizione
' le variabili clsAmboA,clsAmboB sono valorizzate con gli ambi letti dai rispettivi contenitori
' degli ambi con somma A e gli ambi con somma B
' PARAMETRI
' clsAmboA = Ambo letto dal contenitore A che viene passato dalla procedura chiamante
' clsAmboB = Ambo letto dal contenitore B che viene passato dalla procedura chiamante
' aRuote = serve a far tornare indietro le ruote trovate in modo che la procedira chiamante le sappia
' sNumeri = serve a ffar tornare indietro l a stringa contenente i 4 numeri trovati (i 2 ambi)
Dim clsNum ' variabile per leggere il singolo numero di ciascun ambo
ReDim aPosOccupate(5) ' dimensiono un array che serve a memorizzare le posizioni di uscita dei numeri dei 2 ambi A e B
Dim k,n ' variabili di servizio per controllo cicli , indici di array ecc
Dim sAmboA,sAmboB ' stringhe che serviranno per contenere gli ambi A e B
' azzero le variabili di ritorno
sNumeri = ""
ReDim aRuote(2)
' uso una variabile temporanea per leggere la ruota dell'ambo con somma A
ReDim aR(0)
Call clsAmboA.RuoteInteressateI(aR)
aRuote(1) = aR(1) ' valorizzo l'array che conterra la ruota trovata con la ruota dove è uscito l'ambo A
' uso una variabile temporanea per leggere la ruota dell'ambo con somma B
ReDim aR(0)
Call clsAmboB.RuoteInteressateI(aR)
aRuote(2) = aR(1) 'valorizzo l'array che conterra la ruota trovata con la ruota dove è uscito l'ambo B
' ogni ambo ovviamente contiene 2 numeri
' ciclo sui 2 numeri di ciascuno dei 2 ambi
' serve per verificare l'isotopia
For k = 1 To 2
' valorizzo un array per memorizzare le posizioni di uscita di ogni numero dei 2 ambi
aPosOccupate(clsAmboA.clsNumero(k).Posizione) = True ' ambo a
aPosOccupate(clsAmboB.clsNumero(k).Posizione) = True ' ambo b
' costruisco le stringhe che conterranno gli ambi usciti
sAmboA = sAmboA & Format2(clsAmboA.clsNumero(k).numero) & "." ' concateno un punto alla stringa
sAmboB = sAmboB & Format2(clsAmboB.clsNumero(k).numero) & "."
Next
' ora samboA conterra ad esempio 2 numeri "03.50." e sAmboB ad esempio 2 numeri "04.70."
' notare che compare un punto pure alla fine di ciascuna stringa lo dovremo levare per questioni di bellezza
' concateno le 2 stringhe samboA e samboB contenenti i 2 ambi per far toranre indietro
' alla procedura chiamante la stringa completa con i 4 numeri totali
' siccome le stringhe alla fine contengono un punto di troppo
' lo devo levare percio uso la funzione left
sNumeri = Left(sAmboA,Len(sAmboA) - 1) & "/" & Left(sAmboB,Len(sAmboB) - 1)
' conto le posizioni occupate complessivamentedai 4 numeri
For k = 1 To 5
If aPosOccupate(k) = True Then
n = n + 1
End If
Next
If n = 2 Then
' se le posizioni occupate sono 2 è automatico che i 2 ambi sono isotopi percio la condizionwe è rispettata
CondizioneRispettata = True
End If
End Function
Function Verifica(aNumInGioco,aRuote,idEstrazione,nSorteMinima,nColpiMax, nCasiVincenti )
Dim RetEsito,RetColpi,RetEstratti,RetIdEstr ' parametri di ritorno per VerificaEsito
Dim K 'ì estrazione Inizio Verifica
Dim nColpiRimanenti ' colpi di gioco per le volte che si chiama VerificaEsito
Dim Ret ' risultato di questa funzione
' imposto i valori iniziali
K = idEstrazione ' inizio verifica
nColpiRimanenti = nColpiMax ' colpi di gioco
Ret = False ' per default torna false
' uso la funzione verificaEsito che trona true se è capitato un esito maggiore o uguale a quello previsto entro i dati colpi
' finche la funzione torna True e ci sono ancora possibili colpi di gioco la funzione verificaesito viene rilanciata
' grazie al ciclo do while
Do While VerificaEsito(aNumInGioco,aRuote,K,nSorteMinima,nColpiRimanenti,,RetEsito,RetColpi,RetEstratti,RetIdEstr)
' è capitato un esito positivo e scrivo i numeri usciti
Ret = True ' dato che c'èe stato un esito questa funzione tornera true
Call Scrivi(GetInfoEstrazione(RetIdEstr) & " " & FormatSpace (RetEsito,15) & " colpi : " & FormatSpace(RetColpi, 7) & " " & RetEstratti)
' incremento i casi vincenti
nCasiVincenti =nCasiVincenti +1
' calcolo i colpi rimanenti
nColpiRimanenti = nColpiRimanenti - (RetIdEstr - (K-1))
' calcolo la nuova estrazione di gioco
K = RetIdEstr +1
' se i colpi rimanenti sono finiti esce
If nColpiRimanenti <= 0 Then Exit Do
Loop
' valorizzo il valore di ritorno per la funzione
Verifica = Ret
End Function
Sub AlimentaNumInGioco(aNum)
' procedura che alimenta i numeri in gioco
aNum(1) = 38
aNum(2) = 84
aNum(3) = 3
aNum(4) = 45
aNum(5) = 35
aNum(6) = 44
aNum(7) = 65
aNum(8) = 15
aNum(9) = 82
aNum(10) = 51
aNum(11) = 58
aNum(12) = 77
aNum(13) = 81
End Sub
