Codice

[antonio65]

Buongiorno , chiedo aiuto per un codice :
ho 5 numeri :
a=1
b=2
c=3
d=4
e=5
e li devo accoppiare a 2 a 2 senza alcune operazione di somma, sottrazione etc etc
aa=(1,2)
aa2=(1,3) etc etc
chiedo cortesemente il codice per questo esempio cioè quante volte(esempio)
1e2 quindi aa=(1,2) si accoppiano o meglio vengono estratti…
Grazie in anticipo Antonio65

 

[fillotto]

Prova questo script di Mike58 ti dice vita,morte e miracoli delle combinazioni vedi i codice!!!

 Sub Main

Dim a(10)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITEa
Dim Ru(1)
Dim k
Dim nu
ReDim aruote(12)
Scrivi "( antonio ) Ruota di... ",1,0,4
If ScegliRuote(aruote) > 0 Then
For k = 1 To UBound(aruote)
If aruote(k) > 0 Then
Scrivi " " & NomeRuota(aruote(k)),1,0,3
End If
Next
End If
'rt = CInt(InputBox("Quale ruota analizzare ",Ruota,4))
'Ru(1) = rt
Dim posta(2)
posta(1) = 1
posta(2) = 1
Fin = EstrazioneFin
Ini = EstrazioneIni
Scrivi NomeRuota(Ru(1)),1,0
Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)
ReDim atitoli(33)
atitoli(1) = "TOT."
'atitoli(2) = " esito "
atitoli(3) = "Combinazioni"
'atitoli(4) = " esito "
'atitoli(5) = " estratti "
atitoli(6) = "RCA1"
atitoli(7) = "RCA2"
atitoli(8) = "RCA3"
atitoli(9) = "RCA4"
atitoli(10) = "RCA5"
atitoli(13) = "RS1"
atitoli(14) = "RS2"
atitoli(15) = "RS3"
atitoli(16) = "RS4"
atitoli(17) = "RS5"
atitoli(20) = "FRE1"
atitoli(21) = "FRE2"
atitoli(22) = "FRE3"
atitoli(23) = "FRE4"
atitoli(24) = "FRE5"
atitoli(27) = "RD1"
atitoli(28) = "RD2"
atitoli(29) = "RD3"
atitoli(30) = "RD4"
atitoli(31) = "RD5"
Call InitTabella(atitoli,1,,2,5)
'-------------inserimento combinazioni --------------------------
a(01) = "01-02"
a(02) = "01-03"
a(03) = "01-04"
a(04) = "01-05"
a(05) = "02-03"
a(06) = "02-04"
a(07) = "02-05"
a(08) = "03-04"
a(09) = "03-05"
a(10) = "04-05"
'----------------- fine combinazioni ------------------------------
For N = 1 To UBound(a)
nu = Split("0-" &(a(n)),"-")
sr1 = SerieRitardo(Ini,fin,nu,aruote,1)', 1 scrive il ritardo dell'estratto
sr2 = SerieRitardo(Ini,fin,nu,aruote,2)
sr3 = SerieRitardo(Ini,fin,nu,aruote,3)
sr4 = SerieRitardo(Ini,fin,nu,aruote,4)
sr5 = SerieRitardo(Ini,fin,nu,aruote,5)
st1 = SerieStorico(Ini,fin,nu,aruote,1)
st2 = SerieStorico(Ini,fin,nu,aruote,2)
st3 = SerieStorico(Ini,fin,nu,aruote,3)
st4 = SerieStorico(Ini,fin,nu,aruote,4)
st5 = SerieStorico(Ini,fin,nu,aruote,5)
sf1 = SerieFreq(Ini,Fin,nu,aruote,1)
sf2 = SerieFreq(Ini,Fin,nu,aruote,2)
sf3 = SerieFreq(Ini,Fin,nu,aruote,3)
sf4 = SerieFreq(Ini,Fin,nu,aruote,4)
sf5 = SerieFreq(Ini,fin,nu,aruote,5)
Call VerificaEsito(nu,aruote,fin,2,1,,retesito,,retestratti)
ReDim avalori(33)
avalori(1) = n
'avalori(2) = " esito "
avalori(3) = StringaNumeri(nu)

avalori(6) = sr1
avalori(7) = sr2
avalori(8) = sr3
avalori(9) = sr4
avalori(10) = sr5

avalori(13) = st1
avalori(14) = st2
avalori(15) = st3
avalori(16) = st4
avalori(17) = st5
avalori(20) = sf1
avalori(21) = sf2
avalori(22) = sf3
avalori(23) = sf4
avalori(24) = sf5
avalori(28) = RitDiPos(nu,2,aruote)
avalori(29) = RitDiPos(nu,3,aruote)
avalori(30) = RitDiPos(nu,4,aruote)
avalori(31) = RitDiPos(nu,5,aruote)
Call AddRigaTabella(avalori)
ImpostaGiocata n,nu,aruote,posta,18
'---------colora colonne---------------------
' 1 esempio ------
Call SetColoreCella(1,,vbBlue)
Call SetColoreCella(3,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
Call SetColoreCella(2,3,4)
Call SetColoreCella(4,3,4)
Call SetColoreCella(5,3,4)
Call SetColoreCella(11,3,4)
Call SetColoreCella(12,3,4)
Call SetColoreCella(18,3,4)
Call SetColoreCella(19,3,4)
Call SetColoreCella(25,3,4)
Call SetColoreCella(26,3,4)
Call SetColoreCella(32,3,4)
Call SetColoreCella(33,3,4)
Call SetColoreCella(27,RGB(254,249,180),vbBlue)
Call SetColoreCella(28,RGB(254,249,180),vbBlue)
Call SetColoreCella(29,RGB(254,249,180),vbBlue)
Call SetColoreCella(30,RGB(254,249,180),vbBlue)
Call SetColoreCella(31,RGB(254,249,180),vbBlue)
'2 esempio ----------------------------------
' colora la colonna 1 sfondo default bianco  scritta verde
Call SetColoreCella(6,4,0)
Call SetColoreCella(7,0,4)
Call SetColoreCella(8,4,0)
Call SetColoreCella(9,0,4)
Call SetColoreCella(10,4,0)
Next
Scrivi
Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
Scrivi
Call CreaTabella()
Scrivi"------------------------------------------------ Dettaglio ultime 18 giocate ---------------------------------------------"
Gioca(fin - 18),,,1
ScriviResoconto(True)
'PicClear
Call PicStampaTesto(1,10,"Listed by Mike58 ",,1,1,,11,vbRed)
PicEsegui
End Sub
Function RitDiPos(nu,pos,aruote)
ReDim apos(5)
apos(pos) = True
RitDiPos = RitardoCombinazione(aruote,nu,1,0,apos)
End Function

 

[antonio65]

Ciao filotto, grazie per l'intervento...ci provo a smanettare e/o copiare vedo cosa esce fuori...sono alle prime armi mi è un pò difficile....vediamo!!!

 

[salvo50]

Ciao a Tutti!

 Option Explicit
Sub Main
    Dim X,J,X1,J1,Z,Z1

    Scrivi "Primo esempio"
    For X = 1 To 5
        For J = 1 To 5
        Z = Z + 1
            Scrivi Format2 (Z) & " - " & Format2(X) & " " & Format2(J)

        Next
    Next
    Scrivi "**********"
    Scrivi "Secondo esempio"
    For X1 = 1 To 4
        For J1 = X1 + 1 To 5

            Z1 = Z1 + 1
            Scrivi Format2 (Z1) & " - " & Format2(X1) & " " & Format2(J1)


        Next
    Next
    Scrivi "**********"
End Sub

 

[antonio65]

Ciao SALVO grazie per l'aiuto...ti reiinvio lo script va benissimo ma ho qualche problema dal momento che
i numeri da 1 a 5 mi girano sotto MEN(5) sono dei numeri appunto che vengono fuori da una tecnica...
ora con lo stesso modo che hai fatto tu mi ho cambiato i numeri ed ho messo (MEN) non so se è giusto sicuramente manca qualche richiamo...

For XX = MEN(1) To MEN(5)
For J = MEN(1) To MEN(5)
Scrivi Format2(XX) & " " & Format2(J)
Next
Next
Scrivi "********"
For X1 = MEN(1) To MEN(4)
For J1 =X1 + MEN(1) To MEN(5)
Scrivi Format2(X1) & " " & Format2(J1)
Next
Next

 

[Mike58]

se si tratta di sviluppare dei numeri in una data classe di sviluppo è indicato usare il codice appropriato di sviluppoIntegrale.

Sub Main
 Dim Colonne
 Dim numeri(5)
 Dim classe
 Dim sColonna
 classe = 2
 For k = 1 To 5
  numeri(k) = k
 Next
 Colonne = SviluppoIntegrale(numeri,classe)
 For k = 1 To UBound(Colonne)
  sColonna = ""
  For j = 1 To classe
   sColonna = sColonna & Format2(Colonne(k,j)) & " "
  Next
  Call Scrivi(sColonna)
 Next
End Sub

 

[antonio65]

Grazie Mike del codice...ora attraverso questo codice è possibile fare girare sempre 10 combinazioni generate da 5 numeri?
cioè dall' 1 to 5 potrebbero diventare MEN(1) TO MEN(5) all'interno di uno script o sono fuori strada? Grazie!!!

 

[Mike58]

Tutto è possibile,basta assegnarli poi i Numeri in Vettori e forzare il tutto.

Però nei tuoi casi è meglio intervenire sullo script di Salvo.

Provaci..... tutto è possibile.

Ciao

 

[antonio65]

Grazieeeeeeeeeeeeeeeeeeeee

 

[Mike58]

Come vedi in questo 2° script ho assegnato un valore ai numeri e sviluppato.

Option Explicit
Sub Main
 Dim k,s
 Dim nClasse,nColonneTot
 ReDim aNumeri(90)
 Dim aCol
 Dim MEN(5)
 nClasse = 2 ' sviluppo in ambi
 ' inizializzo i numeri da sviluppare in questo caso 90
 ' ma potrebbero essere anche di meno
 '.................................
 'For k = 1 To 5
 'aNumeri(k) = k
 'Next
 '---------------------------------
 MEN(1) = 11
 MEN(2) = 22
 MEN(3) = 33
 MEN(4) = 44
 MEN(5) = 55
 'inizializza lo sviluppo
 nColonneTot = InitSviluppoIntegrale(MEN,nClasse)
 k = 0
 ' ciclo che continua fiono a quando le colonne non finiscono
 Do While GetCombSviluppo(aCol)
  k = k + 1 ' conteggio colonna corrente
  ' costruisco la stringa che contiene la colonna
  s = FormatSpace(k,10,True) & "- " & StringaNumeri(aCol)
  Call Scrivi(s)
  Call Messaggio("Colonna " & k)
  If ScriptInterrotto Then Exit Do
 Loop
End Sub

 

[antonio65]

Le tue capacità sono sorprendenti....come tu bene sai sono nuovo e cerco di farmi le ossa...ti assicuro che smanetto giornate intere....
Tuttavia proverò ad inserire nello script tuo i codici ma non penso che ci riuscirò in breve....se vuoi e sopratutto puoi....io ti allego lo script
da te costruito e se puoi inserire tu i codici....Grazie è solo quello che posso dire....


Sub Main
Dim Nu(1),NuFr(90,5),NuAdd(1),aN(10),Num(5),DNA(10),MEN(5)
Dim Ru(1),T
Ini = EstrazioneFin - 500
fin = EstrazioneFin
r = InputBox("Quale Ruota",,7)
pos = CInt(InputBox("Quale posizione",,2))
Ind = CInt(InputBox("Quale indiceMensile",,1))
clp = CInt(InputBox("Quanti Colpi di Gioco",,1))
smm = CInt(InputBox("Quante righe ",,5))

T = Array(T,"Estratto","SOMMATIVO","FREQ SU CASI","ESTR + SOMMATIVO","MEN","10 somme DNA","nu1","nu2","nu3","nu4","nu5","Esito","Verifica","DATA","Colpo","Ritardo x 1")
Call InitTabella(T,6)
For es = Ini To fin
If IndiceMensile(es) = Ind Then
idd = GetInfoEstrazione(es)
Call Messaggio("Costruttore Sommativo per Ambi " & " casi trovati...." & casi)
Call AvanzamentoElab(Ini,fin,es)

For p = 1 To 5
Num(p) = Estratto(es,r,p)
Next
DNA(1) =(Num(1) + Num(2))
DNA(2) =(Num(1) + Num(3))
DNA(3) =(Num(1) + Num(4))
DNA(4) =(Num(1) + Num(5))
DNA(5) =(Num(2) + Num(3))
DNA(6) =(Num(2) + Num(4))
DNA(7) =(Num(2) + Num(5))
DNA(8) =(Num(3) + Num(4))
DNA(9) =(Num(3) + Num(5))
DNA(10) =(Num(4) + Num(5))
stE = StringaEstratti(es,r)
casi = casi + 1
co = 0
Ru(1) = r
es1 = es + 1
es2 = es1 + clp
est = Estratto(es,r,pos)
'------- calcolo sommativo ---------------
For sm = 1 To 90
co = co + 1
Nu(1) = Fuori90(est + sm)
NuFr(co,1) = sm
sf = SerieFreqTurbo(es1,es2,Nu,Ru,1)
If sf > 0 Then
NuFr(co,2) = NuFr(co,2) + 1
End If
Next
End If
Next
' scrivi testo ............................
Scrivi "Ruota di rilevamento : " & NomeRuota(r)
Scrivi "Stringa estratti : " & stE
Scrivi "Indice mensile : " & Ind
Scrivi "Colpi di Gioco : " & clp
Scrivi "Righe visualizzate : " & smm
'------------------------------------------
Call OrdinaMatrice(NuFr,- 1,2)
If(NuFr(i,2)) >= 0 Then
End If
For i = 1 To smm
NuAdd(1) = Fuori90(Nu(1) + NuFr(i,1))
ReDim V(17)
V(1) = pos & "°" & " di " & SiglaRuota(r) & " = " & est
V(2) = " + " & Format2(CStr(NuFr(i,1)))
V(3) = Format2(NuFr(i,2)) & " su " & casi & " Casi "
V(4) = NuAdd(1)
V(5) = NuAdd(1)
MEN(1) = Fuori90(Nu(1) + NuFr(i,1))
MEN(2) = Fuori90(Abs(V(5) - DNA(2)))
MEN(3) = Fuori90(Abs(V(5) - DNA(3)))
MEN(4) = Fuori90(Abs(V(5) - DNA(4)))
MEN(5) = Fuori90(Abs(V(5) - DNA(5)))
V(6) = StringaNumeri(DNA)
V(7) = MEN(1)
V(8) = MEN(2)
V(9) = MEN(3)
V(10) = MEN(4)
V(11) = MEN(5)
sr = SerieRitardo(Ini,fin,MEN,Ru,1)
Call VerificaEsitoTurbo(MEN,Ru,es1,1,1,,esito,colpi,estratti,id)
V(12) = esito
V(13) = estratti
If esito = "Estratto" Or esito = "Terno" Then
V(14) = DataEstrazione(id)
Else
V(14) = " In corso "
End If
V(15) = colpi
V(16) = sr
Call AddRigaTabella(V)
Next
casi = 0
Call CreaTabella()
End Sub

 

[antonio65]

Ci sono riuscito Mike(anche se solo grazie ai tuoi codici) ho creato una finestra successiva con t array ma quante volte esce una coppia non mi compare...poi tutto è fatto.



Sub Main
Dim Nu(1),NuFr(90,5),NuAdd(1),aN(10),Num(5),DNA(10)
Dim Ru(1),T
Dim k,s
Dim nClasse,nColonneTot
ReDim aNumeri(90)
Dim aCol
Dim MEN(5)
nClasse = 2 ' sviluppo in ambi

Ini = EstrazioneFin - 500
fin = EstrazioneFin
r = InputBox("Quale Ruota",,7)
pos = CInt(InputBox("Quale posizione",,2))
Ind = CInt(InputBox("Quale indiceMensile",,1))
clp = CInt(InputBox("Quanti Colpi di Gioco",,1))
smm = CInt(InputBox("Quante righe ",,5))

T = Array(T,"Estratto","SOMMATIVO","FREQ SU CASI","ESTR + SOMMATIVO","MEN","10 somme DNA","nu1","nu2","nu3","nu4","nu5","Esito","Verifica","DATA","Colpo","Ritardo x 1","coppia")
Call InitTabella(T,6)
For es = Ini To fin
If IndiceMensile(es) = Ind Then
idd = GetInfoEstrazione(es)
Call Messaggio("Costruttore Sommativo per Ambi " & " casi trovati...." & casi)
Call AvanzamentoElab(Ini,fin,es)

For p = 1 To 5
Num(p) = Estratto(es,r,p)
Next
DNA(1) =(Num(1) + Num(2))
DNA(2) =(Num(1) + Num(3))
DNA(3) =(Num(1) + Num(4))
DNA(4) =(Num(1) + Num(5))
DNA(5) =(Num(2) + Num(3))
DNA(6) =(Num(2) + Num(4))
DNA(7) =(Num(2) + Num(5))
DNA(8) =(Num(3) + Num(4))
DNA(9) =(Num(3) + Num(5))
DNA(10) =(Num(4) + Num(5))
stE = StringaEstratti(es,r)
casi = casi + 1
co = 0
Ru(1) = r
es1 = es + 1
es2 = es1 + clp
est = Estratto(es,r,pos)
'------- calcolo sommativo ---------------
For sm = 1 To 90
co = co + 1
Nu(1) = Fuori90(est + sm)
NuFr(co,1) = sm
sf = SerieFreqTurbo(es1,es2,Nu,Ru,1)
If sf > 0 Then
NuFr(co,2) = NuFr(co,2) + 1
End If
Next
End If
Next
' scrivi testo ............................
Scrivi "Ruota di rilevamento : " & NomeRuota(r)
Scrivi "Stringa estratti : " & stE
Scrivi "Indice mensile : " & Ind
Scrivi "Colpi di Gioco : " & clp
Scrivi "Righe visualizzate : " & smm
'------------------------------------------
Call OrdinaMatrice(NuFr,- 1,2)
If(NuFr(i,2)) >= 0 Then
End If
For i = 1 To smm
NuAdd(1) = Fuori90(Nu(1) + NuFr(i,1))
ReDim V(17)
V(1) = pos & "°" & " di " & SiglaRuota(r) & " = " & est
V(2) = " + " & Format2(CStr(NuFr(i,1)))
V(3) = Format2(NuFr(i,2)) & " su " & casi & " Casi "
V(4) = NuAdd(1)
V(5) = NuAdd(1)
MEN(1) = Fuori90(Abs(V(5) - DNA(1)))
MEN(2) = Fuori90(Abs(V(5) - DNA(2)))
MEN(3) = Fuori90(Abs(V(5) - DNA(3)))
MEN(4) = Fuori90(Abs(V(5) - DNA(4)))
MEN(5) = Fuori90(Abs(V(5) - DNA(5)))
V(6) = StringaNumeri(DNA)
V(7) = MEN(1)
V(8) = MEN(2)
V(9) = MEN(3)
V(10) = MEN(4)
V(11) = MEN(5)
nColonneTot = InitSviluppoIntegrale(MEN,nClasse)
k = 0
Do While GetCombSviluppo(aCol)
k = k + 1 ' conteggio colonna corrente
' costruisco la stringa che contiene la colonna
s = FormatSpace(k,10,True) & "- " & StringaNumeri(aCol)
Call Scrivi(s)
Call Messaggio("Colonna " & k)
If ScriptInterrotto Then Exit Do
Loop
sr = SerieRitardo(Ini,fin,MEN,Ru,1)
Call VerificaEsitoTurbo(MEN,Ru,es1,1,1,,esito,colpi,estratti,id)
V(12) = esito
V(13) = estratti
If esito = "Estratto" Or esito = "Terno" Then
V(14) = DataEstrazione(id)
Else
V(14) = " In corso "
End If
V(15) = colpi
V(16) = sr
V(17) = k
Call AddRigaTabella(V)
Next
casi = 0
Call CreaTabella()
End Sub

 

[Mike58]

Ciao Antonio, se ci sei quasi, bene, se inveve cerchi di mettere la frequenza di ogni coppia non puoi metterla in tabella, perché hai 2 pezzi di script che non si parlano fra loro.

Tuttavia hai la scrittura in sviluppo e quindi hai il numero vettore (aCol) puoi qui farci una SerieFreq con il vettore relativo (aCol).

Provaci....questa settimana non ho + tempo.....lavoro notturno.

Ciao