solare
Advanced Member >PLATINUM<
Ciao, Come puoi vedere nell'immagine vengono riportate le cinquine dove sono sortite le ambate in questo caso trattiamo la ruota di venezia.
Quello che vorrei io, se possibile è: avere la visualizzazione dei numeri sortiti assieme alle ambate con la ripetizione > di 1 presenza.
es con l'82 ambata, per ben 2 volte è presente il numero 30. In sostanza avere una tabella dove mi riporta i numeri simpatici delle ambate in gioco sempre relative alle cinquine visualizzate.
Quello che vorrei io, se possibile è: avere la visualizzazione dei numeri sortiti assieme alle ambate con la ripetizione > di 1 presenza.
es con l'82 ambata, per ben 2 volte è presente il numero 30. In sostanza avere una tabella dove mi riporta i numeri simpatici delle ambate in gioco sempre relative alle cinquine visualizzate.
Codice:
Option Explicit
Sub Main()
Dim n,ru,p,est,d,es,i,f,j,retestratti,retidestr,XI,k,mm,aretritardi,aretidestr,scelta,nNumSel,lista,ww
Dim nc,qe,mmaapp,Aanno,cusc,mmu,ne,sel,jh,conta,c,jk,kk,retfre,fine,z,Sino,pp,ix,X,XC,last,Xy,Ini
Dim ar(1),colpo(14)
ru = InputBox("Ruota di gioco",,1)
fine = InputBox("fino Estraz.n.",,EstrazioneFin)
scelta = InputBox("D=DecCab F=Fig C=Cad U=Utente ",,"D")
ix = CInt(InputBox("Indice mensile 1:13",,1))
If scelta = "U" Or scelta = "u" Then
Dim ute(10)
nNumSel = ScegliNumeri(ute)
End If
Scrivi "_____________________________________________ ____ ____________________________"
Scrivi "Ruota di " & NomeRuota(ru),1
Scrivi "Ultima estrazione " & fine & " / " & DataEstrazione(fine),1
If scelta = "D" Then Scrivi "Richiesta Decina Cabalistica",1
If scelta = "F" Then Scrivi "Richiesta Figure ",1
If scelta = "C" Then Scrivi "Richiesta Cadenze ",1
If scelta = "U" Then Scrivi "Richiesta Numeri Utente " & StringaNumeri(ute,"-"),1
Scrivi "Indice Mensile Richiesto...." & ix,1
Scrivi "_____________________________________________ ____ ____________________________"
ar(1) = ru
'''
For n = 8945 To fine
es = n
If IndiceMensile(n) = ix Then
conta = conta + 1
mm = Mid(DataEstrazione(es),4,2)
ReDim ambate(20,2),an(25)
f = 0
est = ""
For p = 1 To 5
est = est & Format2(Estratto(n,ru,p)) & "."
Next
If scelta = "D" Then d = DecinaCabalistica(Format2(Estratto(n,ru,1)))
If scelta = "F" Then d = Figura(Estratto(n,ru,1))
If scelta = "C" Then d = Cadenza(Estratto(n,ru,1))
If scelta = "U" Then d = ute(1)
Scrivi "---------------------------------------------------------------------------------------------",1
ColoreTesto(1)
If scelta = "D" Then Scrivi n & " / " & DataEstrazione(n) & "...." & SiglaRuota(ru) & "..." & est & ".1 Estratto.Dec.Cab. da " & d - 1 & "0" & " : " & d - 1 & "9",1
If scelta = "F" Then Scrivi n & " / " & DataEstrazione(n) & "...." & SiglaRuota(ru) & "..." & est & ".1 Estratto.figura ( " & d & " ) ",1
If scelta = "C" Then Scrivi n & " / " & DataEstrazione(n) & "...." & SiglaRuota(ru) & "..." & est & ".1 Estratto.Cadenza. ( " & d & " ) ",1
If scelta = "U" Then Scrivi n & " / " & DataEstrazione(n) & "...." & SiglaRuota(ru) & "..." & est & ".1 Estratto.Utente. da ( " & d & " ) a " & ute(nNumSel),1
ColoreTesto(0)
ReDim nr(90),ambate(90)
For es = n To n + 14
mmu = Mid(DataEstrazione(es),4,2)
If mmu <> mm Then Exit For
If es > EstrazioneFin Then Exit For
For i = 1 To 5
If scelta = "D" And DecinaCabalistica(Estratto(es,ru,i)) = Int(d) Then
ne = Estratto(es,ru,i)
ambate(ne) = ambate(ne) + 1
f = f + 1
nr(f) = ne
End If
If scelta = "F" And Figura(Estratto(es,ru,i)) = Int(d) Then
ne = Estratto(es,ru,i)
ambate(ne) = ambate(ne) + 1
f = f + 1
nr(f) = ne
End If
If scelta = "C" And Cadenza(Estratto(es,ru,i)) = Int(d) Then
ne = Estratto(es,ru,i)
ambate(ne) = ambate(ne) + 1
f = f + 1
nr(f) = ne
End If
XC = 0
If scelta = "U" Then
For X = 1 To nNumSel
If Int(ute(X)) > 0 Then
If Int(Estratto(es,ru,i)) = Int(ute(X)) Then
XC = XC + 1
End If
End If
Next
If XC >= 1 Then
ne = Estratto(es,ru,i)
ambate(ne) = ambate(ne) + 1
f = f + 1
nr(f) = ne
End If
End If
Next
Next
If f >= 2 Then
Scrivi "con ripetuti..." & StringaNumeri(nr,".")
sel = "" : j = 0:c = 1
ReDim ab(25),bc(3)
For jh = 1 To f
'''controllo se già esiste
For kk = 1 To c
If nr(jh) = ab(kk) Then
Exit For
End If
Next
'''aggiunge se nuovo
If Int(ab(kk)) = 0 And Int(nr(jh)) <> Int(ab(kk)) Then
c = c + 1
ab(c) = nr(jh)
End If
Next
''prepara combinazione per nuovo mese con ultimi 3 non ripetuti da dx verso sx
bc(1) = ab(c)
bc(2) = ab(c - 1)
bc(3) = ab(c - 2)
an(1) = bc(1)
an(2) = bc(2)
an(3) = bc(3)
'''carico numeri per prossimo mese arrays (an)
sel = Format2(an(1)) & "." & Format2(an(2)) & "." & Format2(an(3))
''''''
Scrivi "Senza Ripetuti " & StringaNumeri(ab,".") & " Tot.Qt numeri.." & c - 1
ColoreTesto(2)
Scrivi "---> Ambate per gioco prossimo mese.." & MeseNome(mm + 1) & " ..." & sel,1
'''verifica esito nel mese in corso
ColoreTesto(1)
Call VerificaEsitoTurbo(an,ar,n + 13,1,13,,,,retestratti,retidestr)
If retestratti <> "" Then
Scrivi "----> Uscito estratto..." & retestratti & " al conc." & retidestr & " / " & DataEstrazione(retidestr) & "... colpo n." & retidestr -(n + 13)
XI = 1
colpo(retidestr -(n + 12)) = colpo(retidestr -(n + 12)) + 1
Else
If Mese(n) = Month(Date) And Anno(n) = Year(Date) Then
Scrivi " In creazione combinazione per New Mese ",1
Else
If n > fine Then
Scrivi " Esito NEGATIVO ",1
colpo(14) = colpo(14) + 1
Exit For
End If
colpo(14) = colpo(14) + 1
Scrivi "Attualmente NEGATIVO ",1
End If
ColoreTesto(0)
End If
End If
End If
Next
''''' riepilogo successi per ncolpo
Scrivi
ColoreTesto(2)
Scrivi "Ruota di " & NomeRuota(ru),1
Scrivi "Periodo da estraz.n.8946 " & DataEstrazione(8946) & " a " & fine & " / " & DataEstrazione(fine),1
ColoreTesto(0)
Scrivi "Riepilogo successi per n.colpo di gioco",1
For k = 1 To 13
Scrivi "Colpo n." & Format2(k) & "...Successi..." & colpo(k),1
Next
Scrivi "---------- Negativi..." & colpo(14),1
Scrivi "Combinazioni Totali rintracciate.." & conta,1
Scrivi
ColoreTesto(1)
Scrivi "------Situazione Ciclica Mensile Ultimi Anni -------",1
Scrivi "Elenca ultime uscite nel Mese degli ultimi anni",1
ColoreTesto(0)
ReDim atitoli2(13),avalori2(13)
' preimposto i titoli delle colonne
atitoli2(1) = " Estratti "
atitoli2(2) = " Ruota "
atitoli2(3) = " In gioco "
atitoli2(4) = " UsciteAnniPrec."
atitoli2(5) = " Pres.Totali 18E"
atitoli2(6) = " 1.Pos.Fr.Sto "
atitoli2(7) = " 2.Pos.Fr.Sto "
atitoli2(8) = " 3.Pos.Fr.Sto "
atitoli2(9) = " 4.Pos.Fr.Sto "
atitoli2(10) = " 5.Pos.Fr.Sto "
atitoli2(11) = "MediaGlobTeoFreqPosiz"
atitoli2(12) = " Pos.Prefer "
atitoli2(13) = " Pos.Prefer "
' ' inizializzo la tabella
SetTableWidth("90%")
Call InitTabella(atitoli2,1,"center",1.4,5,"Cambria")
avalori2(1) = StringaNumeri(an,".")
avalori2(2) = SiglaRuota(ru)
avalori2(3) = MeseNome(mm + 1)
'''ricerca uscite estratti stesso mese nei 3 anni precedenti
Call ElencoRitardiTurbo(an,ar,1,fine -(156*4),fine - 50,aretritardi,aretidestr)
nc = UBound(aretritardi) - 1
Scrivi "Periodo:" & fine -(156*4) & " : " & fine
For qe = 1 To nc
mmaapp = Mid(DataEstrazione(aretidestr(qe)),4,2)
Aanno = Mid(DataEstrazione(aretidestr(qe)),7,4)
If Int(mm + 1) = Int(mmaapp) Then
'''controlla numeri usciti negli anni passati
lista = ""
For ww = 1 To 5
If Estratto(aretidestr(qe),ar(1),ww) = an(1) Or Estratto(aretidestr(qe),ar(1),ww) = an(2) Or Estratto(aretidestr(qe),ar(1),ww) = an(3) Then
lista = lista & GetTestoHtml(Format2(Estratto(aretidestr(qe),ar(1),ww)),,vbRed) & "."
Else
lista = lista & GetTestoHtml(Format2(Estratto(aretidestr(qe),ar(1),ww)),,vbBlack) & "."
End If
Next
cusc = cusc + 1
Scrivi "Estratti In gioco " & GetTestoHtml(StringaNumeri(an,"."),,vbRed) & " Mese.." & Int(mm + 1) & "...anno..." & Aanno & " Uscite..." & Format2(cusc) & " " & lista,1
End If
Next
avalori2(4) = cusc
'''calcola presenze
Call StatisticaFormazioneTurbo(an,ar,1,,,,retfre,fine - 18,fine)
avalori2(5) = retfre
'''''Ritardista e/o frequentista Estratti e posizioni determinate
ReDim apos(1),posdet(5,2)
For pp = 1 To 5
apos(1) = pp
Call StatisticaFormazioneTurbo(an,ar,1,,,,retfre,3950,fine,,apos)
posdet(pp,1) = retfre
posdet(pp,2) = pp
Next
avalori2(6) = posdet(1,1)
avalori2(7) = posdet(2,1)
avalori2(8) = posdet(3,1)
avalori2(9) = posdet(4,1)
avalori2(10) = posdet(5,1)
''''''''''''''''''''
avalori2(11) = Int((fine - 3949)/90*3)
'''ritardista o frequentista
Call OrdinaMatrice(posdet,- 1)
avalori2(13) = posdet(3,2) & "." & posdet(4,2) & "." & posdet(5,2) & " Ritsta."
avalori2(12) = posdet(1,2) & "." & posdet(2,2) & " Freqsta."
'''
Call AddRigaTabella(avalori2,Bianco_,"center",1)
Call SetColoreCella(6,RGB(226,226,226),vbBlack)
Call SetColoreCella(7,RGB(226,226,226),vbBlack)
Call SetColoreCella(8,RGB(226,226,226),vbBlack)
Call SetColoreCella(9,RGB(226,226,226),vbBlack)
Call SetColoreCella(10,RGB(226,226,226),vbBlack)
Call SetColoreCella(12,RGB(255,185,151),vbBlack)
Call SetColoreCella(13,RGB(255,185,151),vbBlack)
Scrivi
Call CreaTabella
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''
'''' seconda tabella
ReDim atitoli(21),avalori(21)
' preimposto i titoli delle colonne
atitoli(1) = " Estratti Combinazioni "
atitoli(2) = " Ruota / Rilevati "
atitoli(3) = " Pres.Tot.18 Estrazioni "
atitoli(4) = " Pres.Tot.9 Estrazioni "
atitoli(5) = " 1.Pos.Fr.Sto "
atitoli(6) = " 2.Pos.Fr.Sto "
atitoli(7) = " 3.Pos.Fr.Sto "
atitoli(8) = " 4.Pos.Fr.Sto "
atitoli(9) = " 5.Pos.Fr.Sto "
atitoli(10) = "MediaGlobTeoFreqPosiz"
atitoli(11) = " Pos.Prefer "
atitoli(12) = " Pos.Prefer "
atitoli(13) = " Us-P9 "
atitoli(14) = " Us-P8 "
atitoli(15) = " Us-P7 "
atitoli(16) = " Us-P6 "
atitoli(17) = " Us-P5 "
atitoli(18) = " Us-P4 "
atitoli(19) = " Us-P3 "
atitoli(20) = " Us-P2 "
atitoli(21) = " Posizione Nr. Ultima Sortita -P1 "
' ' inizializzo la tabella
SetTableWidth("90%")
Call InitTabella(atitoli,2,"center",1.4,5,"Cambria")
avalori(1) = StringaNumeri(ab,".")
avalori(2) = SiglaRuota(ar(1)) & " / " & MeseNome(mm)
'''calcola presenze
Call StatisticaFormazioneTurbo(ab,ar,1,,,,retfre,fine - 18,fine)
avalori(3) = retfre
Call StatisticaFormazioneTurbo(ab,ar,1,,,,retfre,fine - 36,fine)
avalori(4) = retfre
Call AddRigaTabella(avalori,Bianco_,"center",1)
''''singoli numeri
ReDim nn(1)
For z = 2 To c
nn(1) = Int(ab(z))
avalori(1) = Format2(ab(z))
avalori(2) = SiglaRuota(ar(1)) & " / " & MeseNome(mm)
Call StatisticaFormazioneTurbo(nn,ar,1,,,,retfre,fine - 18,fine)
avalori(3) = retfre
Call StatisticaFormazioneTurbo(nn,ar,1,,,,retfre,fine - 9,fine)
avalori(4) = retfre
'''''Ritardista e/o frequentista Estratti e posizioni determinate
ReDim apos(1),posdet(5,2)
For pp = 1 To 5
apos(1) = pp
Call StatisticaFormazioneTurbo(nn,ar,1,,,,retfre,3950,fine,,apos)
posdet(pp,1) = retfre
posdet(pp,2) = pp
Next
avalori(5) = posdet(1,1)
avalori(6) = posdet(2,1)
avalori(7) = posdet(3,1)
avalori(8) = posdet(4,1)
avalori(9) = posdet(5,1)
''''''''''''''''''''
avalori(10) = Int((fine - 3949)/90)
'''CERCA ULTIME USCITE IN CHE POSIZIONE SI E' VERIFICATA
Call ElencoRitardiTurbo(nn,ar,1,3950,fine,aretritardi,aretidestr)
last = UBound(aretritardi) - 1
Ini = last - 9
Xy = 13
For Ini = Ini + 1 To last
pp = Posizione(aretidestr(Ini),ar(1),nn(1))
avalori(Int(Xy)) = pp
Xy = Xy + 1
Next
'''ritardista o frequentista
Call OrdinaMatrice(posdet,- 1)
avalori(12) = posdet(3,2) & "." & posdet(4,2) & "." & posdet(5,2) & " Ritsta."
avalori(11) = posdet(1,2) & "." & posdet(2,2) & " Freqsta."
Call AddRigaTabella(avalori,Bianco_,"center",1)
Call SetColoreCella(5,RGB(226,226,226),vbBlack)
Call SetColoreCella(6,RGB(226,226,226),vbBlack)
Call SetColoreCella(7,RGB(226,226,226),vbBlack)
Call SetColoreCella(8,RGB(226,226,226),vbBlack)
Call SetColoreCella(9,RGB(226,226,226),vbBlack)
Call SetColoreCella(11,RGB(255,185,151),vbBlack)
Call SetColoreCella(12,RGB(255,185,151),vbBlack)
Call SetColoreCella(21,RGB(255,185,151),vbBlack)
Next
Call CreaTabella
End Sub
