Ciao Baffo. Ho "isolato" i numeri da te richiesti. Non sono sempre 4 ( dipende da quante volte la somma/differenza isotopa si ripete nel mese ) anche se nella maggioranza dei casi si hanno due ripetizioni e quindi 4 numeri. Ho previsto le varie situazioni e i numeri sono memorizzati nelle variabili a,b,c,d,e,f,g,h che adesso dovresti riuscire a manipolare. Eventualmente, se necessario, si potrebbe limitare l'analisi ai casi con solo due ripetizioni per avere così soltanto 4 numeri.
Codice:
Option Explicit
Sub Main
Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,Num1,k,kk,conta,conta1,conta2,Nr,Mat_estr_mod(21,5),Ultimo_indice,Vet_sv(5),Vet_somma_estr(21),Mat_sver(21,5),Mat_sver_mod(21,5),Mat_dver(21,5)
Dim es,r,j,esj,ini,fin,co,se,sv,Stringa1,Stringa2,Stringa3,Vet_contr_sv(90,5),Mat_dver_mod(21,5),Vet_contr_dv(90,5),Vet_rip_sv(20),Vet_rip_dv(20)
Dim col,som_rip,Matrice_Estratti(21,5),Tipo,Vet_giocata(10),Linea(5),conta_rip,clp,ok,col2,a,b,c,d,e,f,g,h,var_temp,N1,N2,N3,N4,N5,N6,N7,N8
Dim Tabs(30)
Dim ruota(11)
Dim ruote(11)
Dim posta(10)
Dim poste(10)
clp = 18
posta(1) = 1
posta(2) = 1
posta(3) = 1
poste(2) = 1
Tabs(1) = "Data":Tabs(2) = "Ruota":Tabs(3) = "Estratti"
Tabs(4) = "1°":Tabs(5) = "2°":Tabs(6) = "3°":Tabs(7) = "4°":Tabs(8) = "5°":Tabs(9) = "Somme":Tabs(10) = "Somme -90"
Tabs(11) = "S1":Tabs(12) = "S2":Tabs(13) = "S3":Tabs(14) = "S4":Tabs(15) = "S5"
Tabs(16) = "D1":Tabs(17) = "D2":Tabs(18) = "D3":Tabs(19) = "D4":Tabs(20) = "D5"
Tabs(21) = "S1":Tabs(22) = "S2":Tabs(23) = "S3":Tabs(24) = "S4":Tabs(25) = "S5"
Tabs(26) = "D1":Tabs(27) = "D2":Tabs(28) = "D3":Tabs(29) = "D4":Tabs(30) = "D5"
r = CInt(InputBox(" Scegli la ruota ",,"6"))
col = CInt(InputBox("Scegli la colonna da analizzare Valori 1,2,3,4,5 per le somme Valori 6,7,8,9,10 per le differenze",,5))
som_rip = CInt(InputBox("Scegli il valore della somma/differenza da ricercare",,39))
ini = 8000 ' Inizio 2022 Circa
Ultimo_indice = IndiceMensile(EstrazioneFin)
If IsUltimaDelMese(EstrazioneFin) Then
fin = EstrazioneFin
Else
fin = EstrazioneFin - Ultimo_indice
End If
ResetTimer
' For r = 1 To 11
If r = 11 Then r = 12
co = 0
Scrivi FormatSpace(NomeRuota(r),80,True),1,,Giallo_,,4
Scrivi
For es = ini To fin
Messaggio "elab. estr. [" &(es) & "] " & DataEstrazione(es,1) & " Elaborazione della ruota di " & NomeRuota(r)
Call AvanzamentoElab(ini,fin,es)
If IndiceMensile(es) = 1 Then
Erase Vet_Controllo: Erase Vet_ripetuti: Erase Mat_estr_mod: Erase Vet_sv: Erase Vet_somma_estr:Erase Mat_sver: Erase Mat_dver:Erase Vet_contr_sv
Erase Mat_sver_mod: Erase Mat_dver_mod:Erase Vet_contr_dv
For j = 0 To 20
esj = es + j
For pos = 1 To 5
Num = Estratto(esj,r,pos)
Vet_Controllo(Num,pos) = Vet_Controllo(Num,pos) + 1
Matrice_Estratti(j,pos) = Num
Mat_estr_mod(j,pos) = Num
Vet_sv(pos) = Vet_sv(pos) + Num
Vet_somma_estr(j) = Vet_somma_estr(j) + Num
If j > 0 Then
Mat_sver(j,pos) = Fuori90(Mat_estr_mod(j,pos) + Mat_estr_mod(j - 1,pos))
Mat_sver_mod(j,pos) = Mat_sver(j,pos)
Mat_dver(j,pos) = Fuori90(Abs(Mat_estr_mod(j,pos) - Mat_estr_mod(j - 1,pos)))
Mat_dver_mod(j,pos) = Mat_dver(j,pos)
Vet_contr_sv(Mat_sver(j,pos),pos) = Vet_contr_sv(Mat_sver(j,pos),pos) + 1
Vet_contr_dv(Mat_dver(j,pos),pos) = Vet_contr_dv(Mat_dver(j,pos),pos) + 1
End If
Next
If IsUltimaDelMese(esj) Then Exit For
Next
For j = 0 To 20
esj = es + j
For pos = 1 To 5
Num = Estratto(esj,r,pos)
If Vet_Controllo(Num,pos) < 2 Then Mat_estr_mod(j,pos) = " "
Num1 = CInt(Mat_sver(j,pos))
If Vet_contr_sv(Num1,pos) < 2 Then Mat_sver_mod(j,pos) = " "
Num1 = CInt(Mat_dver(j,pos))
If Vet_contr_dv(Num1,pos) < 2 Then Mat_dver_mod(j,pos) = " "
Next
If IsUltimaDelMese(esj) Then Exit For
Next
'Verifica presenza somma/differenza richiesta
ok = 0
For j = 0 To 20
If col <= 5 Then
If Mat_sver_mod(j,col) = som_rip Then ok = 1
End If
If col > 5 Then
If Mat_dver_mod(j,col - 5) = som_rip Then ok = 1
End If
If ok = 1 Then Exit For
Next
If ok = 1 Then
co = co + 1
Scrivi String(100,"°") & " Caso n°" & co,1
conta = 0: conta1 = 0: conta2 = 0
For k = 1 To 90
For kk = 1 To 5
If Vet_Controllo(k,kk) > 1 Then
conta = conta + 1
Vet_ripetuti(conta) = k
End If
If Vet_contr_sv(k,kk) > 1 Then
conta1 = conta1 + 1
Vet_rip_sv(conta1) = k
End If
If Vet_contr_dv(k,kk) > 1 Then
conta2 = conta2 + 1
Vet_rip_dv(conta2) = k
End If
Next
Next
Scrivi
EliminaRipetuti Vet_ripetuti
EliminaRipetuti Vet_rip_sv
EliminaRipetuti Vet_rip_dv
Scrivi
Scrivi
' ************ TABELLA *********
Call InitTabella(Tabs,RGB(224,224,224),,,2,5)' inzializzazione
ReDim tabs2(30)
For j = 0 To 20
esj = es + j
tabs2(1) = DataEstrazione(esj)
tabs2(2) = SiglaRuota(r)
tabs2(3) = StringaEstratti(esj,r)
For pos = 1 To 5
tabs2(3 + pos) = Mat_estr_mod(j,pos)
Next
tabs2(9) = Vet_somma_estr(j)
tabs2(10) = Fuori90(Vet_somma_estr(j))
For pos = 1 To 5
tabs2(10 + pos) = Mat_sver(j,pos) '*****************
tabs2(15 + pos) = Mat_dver(j,pos) '*****************
tabs2(20 + pos) = Mat_sver_mod(j,pos) '*****************
tabs2(25 + pos) = Mat_dver_mod(j,pos) '*****************
Next
Call AddRigaTabella(tabs2,,,2)
Call SetColoreCella(9,6,0)
Call SetColoreCella(10,4,2)
For k = 1 To 5
Call SetColoreCella(k + 3,5,1)
Call SetColoreCella(20 + k,5,1)
Call SetColoreCella(25 + k,5,2)
Next
If IsUltimaDelMese(esj) Then Exit For
Next
Stringa1 = ""
For pos = 1 To 5
If Vet_sv(pos) > 0 Then Stringa1 = Stringa1 &(Vet_sv(pos)) & "."
Next
tabs2(1) = "Somma Verticale"
tabs2(2) = SiglaRuota(r)
tabs2(3) = Stringa1
tabs2(4) = "":tabs2(5) = "":tabs2(6) = "":tabs2(7) = "":tabs2(8) = "":tabs2(9) = "":tabs2(10) = ""
tabs2(11) = "":tabs2(12) = "":tabs2(13) = "":tabs2(14) = "":tabs2(15) = "":tabs2(16) = "":tabs2(17) = "":tabs2(18) = "":tabs2(19) = "":tabs2(20) = ""
tabs2(21) = "":tabs2(22) = "":tabs2(23) = "":tabs2(24) = "":tabs2(25) = "":tabs2(26) = "":tabs2(27) = "":tabs2(28) = "":tabs2(29) = "":tabs2(30) = ""
Call AddRigaTabella(tabs2,,,2)
Call SetColoreCella(1,6,2):Call SetColoreCella(2,5,2):Call SetColoreCella(3,6,2)
Stringa2 = ""
For pos = 1 To 5
If Vet_sv(pos) > 0 Then Stringa2 = Stringa2 & Fuori90(Vet_sv(pos)) & "."
Next
Stringa3 = ""
For pos = 1 To 5
If Vet_ripetuti(pos) > 0 Then Stringa3 = Stringa3 & Fuori90(Vet_ripetuti(pos)) & "."
Next
tabs2(1) = "Somma V. -90"
tabs2(2) = SiglaRuota(r)
tabs2(3) = Stringa2
tabs2(4) = "":tabs2(5) = "":tabs2(6) = "":tabs2(7) = "":tabs2(8) = "":tabs2(9) = ""::tabs2(10) = "":
Call AddRigaTabella(tabs2,,,2)
Call SetColoreCella(1,4,2):Call SetColoreCella(2,5,2):Call SetColoreCella(3,4,2)
tabs2(1) = "Nr ripetuti isotopi"
tabs2(2) = SiglaRuota(r)
tabs2(3) = Stringa3
Call AddRigaTabella(tabs2,,,2)
Call SetColoreCella(1,3,2):Call SetColoreCella(2,5,2):Call SetColoreCella(3,3,2)
Call CreaTabella()
Scrivi
'Ricerca colonnare su ruota
Erase Linea: Erase Vet_giocata
conta_rip = 0
If col > 0 And col <= 5 Then
For j = 0 To 20
esj = es + j
If som_rip = Mat_sver_mod(j,col) Then
conta_rip = conta_rip + 1
Linea(conta_rip) = j
End If
If IsUltimaDelMese(esj) Then Exit For
Next
End If
If col > 5 And col <= 10 Then
For j = 0 To 20
esj = es + j
If som_rip = Mat_dver_mod(j,col - 5) Then
conta_rip = conta_rip + 1
Linea(conta_rip) = j
End If
If IsUltimaDelMese(esj) Then Exit For
Next
End If
col2 = col
If col2 > 5 Then col2 = col2 - 5
For k = 1 To conta_rip
Vet_giocata((k - 1)*2 + 1) = Matrice_Estratti(Linea(k),col2)
Vet_giocata((k - 1)*2 + 2) = Matrice_Estratti(Linea(k) - 1,col2)
Next
EliminaRipetuti(Vet_giocata)
If col > 5 Then Scrivi "Differenza consecutivi isotopi = " & som_rip & " in posizione " & col - 5 & " ",True,0,,2,2
If col <= 5 Then Scrivi "Somma isotopi " & som_rip & " in posizione " & col & " ",True,0,,1,2
For k = 1 To conta_rip*2
If Vet_giocata(k) > 0 Then Scrivi Vet_giocata(k) & ".",1,False,,2
Next
If Vet_giocata(1)>0 Then a=Vet_giocata(1): Scrivi " a=" & a,1,False
If Vet_giocata(2)>0 Then b=Vet_giocata(2): Scrivi " b=" & b,1,False
If Vet_giocata(3)>0 Then c=Vet_giocata(3): Scrivi " c=" & c,1,False
If Vet_giocata(4)>0 Then d=Vet_giocata(4): Scrivi " d=" & d,1,False
If Vet_giocata(5)>0 Then e=Vet_giocata(5): Scrivi " e=" & e,1,False
If Vet_giocata(6)>0 Then f=Vet_giocata(6): Scrivi " f=" & f,1,False
If Vet_giocata(7)>0 Then g=Vet_giocata(7): Scrivi " g=" & g,1,False
If Vet_giocata(8)>0 Then h=Vet_giocata(8): Scrivi " h=" & h,1,False
Scrivi
Scrivi String(100,"°"),1
ruota(1) = r
ruote(1) = 11
ImpostaGiocata 1,Vet_giocata,ruota,posta,clp
ImpostaGiocata 2,Vet_giocata,ruote,poste,clp
Gioca esj,1,,1
Scrivi
If esj + 1 > EstrazioneFin Then Exit For
Scrivi String(75,"-"),1
Scrivi
Scrivi "Controllo visivo Prima/Ultima Mese ",1,,,1,2
Scrivi "Prima Estrazione Mese " & DataEstrazione(es) & " - " & SiglaRuota(r) & " - " & StringaEstratti(es,r),1
Scrivi "Ultima Estrazione Mese " & DataEstrazione(esj) & " - " & SiglaRuota(r) & " - " & StringaEstratti(esj,r),1
Scrivi String(75,"-"),1
Scrivi
End If
End If
Next
'next
Scrivi String(100,"*")
ColoreTesto 2
Scrivi" casi trovati : " & co,1
ColoreTesto 0
Scrivi String(100," * ")
ScriviResoconto
TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub
