Novità

R.V.M.

BaffoBlù

Advanced Member >PLATINUM<
Ricerca Verticale Mensile



Salve a tutti


La pionieristica nel lotto è sempre stata una mia priorità,
ma non sono uno scripter di qualità, con tutte le limitazione che questo comporta...


Questa sera vi parlo della ricerca verticale mensile
tramite un occhio diverso, ma in fondo non tanto.

Quello che cerco di fare è portare le stesse regole di ricerca del lotto classico,
(ove ciò fosse possibile...), nella ricerca verticale mensile nei limiti del possibile.


Questo script è solo lo scheletro base della ricerca verticale mensile...

Parte tutto da uno script modificato da maldor e rimodificato da me

lo script (funzionante) non è tuttavia completo...


Aiuto...

vorrei arrivare a fare le cose che faccio con le immagini che vedrete in basso dopo lo script...
(portare il Verticale in Orizzontale come le immagini sarebbe carino...magari in tabelle...)

le immagini sono solo un esempio di tutto quello che si potrebbe visionare "Diversamente"...

Non lo so come andrà a finire...Ma forse in futuro ci sarà bisogno di funzioni apposite...


fate girare, così vi rendete conto fin dove...e poi mi blocco per la somma verticale giusta
non andando più avanti...




Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,k,kk,conta,Nr,Mat_estr_mod(21,5),Ultimo_indice
   Dim es,r,j,esj,ini,fin,co,se,sv
   Dim ruota(11)
   ruota(1) = r
   ini = 10000 ' 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
            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
                  Mat_estr_mod(j,pos) = Num
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            Scrivi "                                         1° . 2° . 3° . 4° . 5° . ",,,,2,2
            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) = "  "
               Next
               Scrivi DataEstrazione(esj) & " - " & SiglaRuota(r) & " - " & StringaEstratti(esj,r) & " ******* " & Format2(Mat_estr_mod(j,1)) & " . " & Format2(Mat_estr_mod(j,2)) & " . " & Format2(Mat_estr_mod(j,3)) & " . " & Format2(Mat_estr_mod(j,4)) & " . " & Format2(Mat_estr_mod(j,5)) & " . ",1,,,1,2
               If IsUltimaDelMese(esj) Then Exit For
            Next
            conta = 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
               Next
            Next
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            Scrivi
            If esj + 1 > EstrazioneFin Then Exit For
            '
            Scrivi String(70,"-"),1
            For j = 0 To 20
               esj = es + j
               se = Fuori90(Estratto(esj,r,1) + Estratto(esj,r,2) + Estratto(esj,r,3) + Estratto(esj,r,4) + Estratto(esj,r,5))
               Scrivi DataEstrazione(esj) & " * " & " Somma Estratti : " & Estratto(esj,r,1) + Estratto(esj,r,2) + Estratto(esj,r,3) + Estratto(esj,r,4) + Estratto(esj,r,5) & " * Fuori 90 = " & Format2(se),1,,,,2
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            Scrivi String(50,"-"),1
            For j = 0 To 20
               esj = es + j
               Scrivi DataEstrazione(esj) & " - " & "1° Estratto : " & Format2(Estratto(esj,r,1)),1,,,1,2
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            For j = 0 To 19
               esj = es + j
               'sv = SommaEstratti(Estratto(esj,r,1))
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            Scrivi String(50,"-"),1
            Scrivi "Somma Verticale 1° Estratti : " & sv,1,,,1,2
            Scrivi String(70,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub


**********************************************************

1.png

2.png

3.png

4.png
 
Ricerca Verticale Mensile



Salve a tutti


La pionieristica nel lotto è sempre stata una mia priorità,
ma non sono uno scripter di qualità, con tutte le limitazione che questo comporta...


Questa sera vi parlo della ricerca verticale mensile
tramite un occhio diverso, ma in fondo non tanto.

Quello che cerco di fare è portare le stesse regole di ricerca del lotto classico,

(ove ciò fosse possibile...), nella ricerca verticale mensile nei limiti del possibile.


Questo script è solo lo scheletro base della ricerca verticale mensile...

Parte tutto da uno script modificato da maldor e rimodificato da me

lo script (funzionante) non è tuttavia completo...


Aiuto...

vorrei arrivare a fare le cose che faccio con le immagini che vedrete in basso dopo lo script...
(portare il Verticale in Orizzontale come le immagini sarebbe carino...magari in tabelle...)

le immagini sono solo un esempio di tutto quello che si potrebbe visionare "Diversamente"...

Non lo so come andrà a finire...Ma forse in futuro ci sarà bisogno di funzioni apposite...


fate girare, così vi rendete conto fin dove...e poi mi blocco per la somma verticale giusta
non andando più avanti...




Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,k,kk,conta,Nr,Mat_estr_mod(21,5),Ultimo_indice
   Dim es,r,j,esj,ini,fin,co,se,sv
   Dim ruota(11)
   ruota(1) = r
   ini = 10000 ' 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
            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
                  Mat_estr_mod(j,pos) = Num
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            Scrivi "                                         1° . 2° . 3° . 4° . 5° . ",,,,2,2
            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) = "  "
               Next
               Scrivi DataEstrazione(esj) & " - " & SiglaRuota(r) & " - " & StringaEstratti(esj,r) & " ******* " & Format2(Mat_estr_mod(j,1)) & " . " & Format2(Mat_estr_mod(j,2)) & " . " & Format2(Mat_estr_mod(j,3)) & " . " & Format2(Mat_estr_mod(j,4)) & " . " & Format2(Mat_estr_mod(j,5)) & " . ",1,,,1,2
               If IsUltimaDelMese(esj) Then Exit For
            Next
            conta = 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
               Next
            Next
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            Scrivi
            If esj + 1 > EstrazioneFin Then Exit For
            '
            Scrivi String(70,"-"),1
            For j = 0 To 20
               esj = es + j
               se = Fuori90(Estratto(esj,r,1) + Estratto(esj,r,2) + Estratto(esj,r,3) + Estratto(esj,r,4) + Estratto(esj,r,5))
               Scrivi DataEstrazione(esj) & " * " & " Somma Estratti : " & Estratto(esj,r,1) + Estratto(esj,r,2) + Estratto(esj,r,3) + Estratto(esj,r,4) + Estratto(esj,r,5) & " * Fuori 90 = " & Format2(se),1,,,,2
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            Scrivi String(50,"-"),1
            For j = 0 To 20
               esj = es + j
               Scrivi DataEstrazione(esj) & " - " & "1° Estratto : " & Format2(Estratto(esj,r,1)),1,,,1,2
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            For j = 0 To 19
               esj = es + j
               'sv = SommaEstratti(Estratto(esj,r,1))
               If IsUltimaDelMese(esj) = True Then Exit For
            Next
            Scrivi String(50,"-"),1
            Scrivi "Somma Verticale 1° Estratti : " & sv,1,,,1,2
            Scrivi String(70,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub


**********************************************************

Vedi l'allegato 2286803

Vedi l'allegato 2286804

Vedi l'allegato 2286806

Vedi l'allegato 2286807
Ciao Baffo. Ho modificato un poco lo script che ora calcola le somme verticali. E' organizzato in tabella e se può andare così si potrà implementare anche la parte successiva.
Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,k,kk,conta,Nr,Mat_estr_mod(21,5),Ultimo_indice,Vet_sv(5),Vet_somma_estr(21)
   Dim es,r,j,esj,ini,fin,co,se,sv,Stringa
   Dim ruota(11)
   Dim Tabs(9)
   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 Estr"
   ruota(1) = r
   ini = 10000 ' 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
            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
                  Mat_estr_mod(j,pos) = Num
                  Vet_sv(pos) = Vet_sv(pos) + Num
                  Vet_somma_estr(j) = Vet_somma_estr(j) + Num
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            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) = "  "
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            conta = 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
               Next
            Next   
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            Scrivi
            Scrivi

            ' ************  TABELLA   *********
            Call InitTabella(Tabs,RGB(224,224,224),,,2,5)' inzializzazione
            ReDim tabs2(9)
            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)=Fuori90(Vet_somma_estr(j))
               Call AddRigaTabella(tabs2,,,2)
               Call SetColoreCella(9,4,2)
               Call SetColoreCella(4,5,1):Call SetColoreCella(5,5,1):Call SetColoreCella(6,5,1):Call SetColoreCella(7,5,1):Call SetColoreCella(8,5,1)

               If IsUltimaDelMese(esj) Then Exit For
            Next
            Stringa=""   
            For pos=1 To 5
                Stringa=Stringa & Fuori90(Vet_sv(pos)) & "."
            Next
            tabs2(1) = "Somma vert estr"
            tabs2(2) = SiglaRuota(r)
            tabs2(3) = Stringa
            tabs2(4)="":tabs2(5)="":tabs2(6)="":tabs2(7)="":tabs2(8)="":tabs2(9)="":
            Call AddRigaTabella(tabs2,,,2)
            Call SetColoreCella(1,4,2):Call SetColoreCella(2,4,2):Call SetColoreCella(3,4,2)
            Call CreaTabella()
            
            If esj + 1 > EstrazioneFin Then Exit For
            
            Scrivi String(75,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub
 
Ciao Baffo. Ho modificato un poco lo script che ora calcola le somme verticali. E' organizzato in tabella e se può andare così si potrà implementare anche la parte successiva.
Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,k,kk,conta,Nr,Mat_estr_mod(21,5),Ultimo_indice,Vet_sv(5),Vet_somma_estr(21)
   Dim es,r,j,esj,ini,fin,co,se,sv,Stringa
   Dim ruota(11)
   Dim Tabs(9)
   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 Estr"
   ruota(1) = r
   ini = 10000 ' 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
            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
                  Mat_estr_mod(j,pos) = Num
                  Vet_sv(pos) = Vet_sv(pos) + Num
                  Vet_somma_estr(j) = Vet_somma_estr(j) + Num
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            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) = "  "
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            conta = 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
               Next
            Next  
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            Scrivi
            Scrivi

            ' ************  TABELLA   *********
            Call InitTabella(Tabs,RGB(224,224,224),,,2,5)' inzializzazione
            ReDim tabs2(9)
            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)=Fuori90(Vet_somma_estr(j))
               Call AddRigaTabella(tabs2,,,2)
               Call SetColoreCella(9,4,2)
               Call SetColoreCella(4,5,1):Call SetColoreCella(5,5,1):Call SetColoreCella(6,5,1):Call SetColoreCella(7,5,1):Call SetColoreCella(8,5,1)

               If IsUltimaDelMese(esj) Then Exit For
            Next
            Stringa=""  
            For pos=1 To 5
                Stringa=Stringa & Fuori90(Vet_sv(pos)) & "."
            Next
            tabs2(1) = "Somma vert estr"
            tabs2(2) = SiglaRuota(r)
            tabs2(3) = Stringa
            tabs2(4)="":tabs2(5)="":tabs2(6)="":tabs2(7)="":tabs2(8)="":tabs2(9)="":
            Call AddRigaTabella(tabs2,,,2)
            Call SetColoreCella(1,4,2):Call SetColoreCella(2,4,2):Call SetColoreCella(3,4,2)
            Call CreaTabella()
           
            If esj + 1 > EstrazioneFin Then Exit For
           
            Scrivi String(75,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub

WOW !!!:love::love::love::love::love::love::love::love::love::love::love:

PERFETTO !


In costruzione a Moduli...
...sarà un mezzo di indagine non indifferente e fuori dai canoni soliti...

chiunque può intervenire per aggiungere un modulo di ricerca in futuro
che sia in script o ( a parole scritte)

Non so se capite dove voglio arrivare...

Questo mezzo di indagine, permetterà di costruire (a parte) script mirati...


per quello che accennavo alla costruzione di funzioni apposite...

sono un visionario che ci volete fare...:cool:
 
wow, son riuscito a modificare lo script per fare anche le somme NON fuori 90



dall'originale


a.png


a così



b.png




sembra una fesseria, ma per me è tanto...


:)



Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,k,kk,conta,Nr,Mat_estr_mod(21,5),Ultimo_indice,Vet_sv(5),Vet_somma_estr(21)
   Dim es,r,j,esj,ini,fin,co,se,sv,Stringa1,Stringa2
   Dim ruota(11)
   Dim Tabs(10)
   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"
   ruota(1) = r
   ini = 10000 ' 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
            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
                  Mat_estr_mod(j,pos) = Num
                  Vet_sv(pos) = Vet_sv(pos) + Num
                  Vet_somma_estr(j) = Vet_somma_estr(j) + Num
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            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) = "  "
               Next
               If IsUltimaDelMese(esj) Then Exit For
            Next
            conta = 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
               Next
            Next
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            Scrivi
            Scrivi
            ' ************  TABELLA   *********
            Call InitTabella(Tabs,RGB(224,224,224),,,2,5)' inzializzazione
            ReDim tabs2(10)
            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))
               Call AddRigaTabella(tabs2,,,2)
               Call SetColoreCella(9,6,0)
               Call SetColoreCella(10,4,2)
               Call SetColoreCella(4,5,1):Call SetColoreCella(5,5,1):Call SetColoreCella(6,5,1):Call SetColoreCella(7,5,1):Call SetColoreCella(8,5,1)
               If IsUltimaDelMese(esj) Then Exit For
            Next
            Stringa1 = ""
            For pos = 1 To 5
               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) = "":
            Call AddRigaTabella(tabs2,,,2)
            Call SetColoreCella(1,6,2):Call SetColoreCella(2,5,2):Call SetColoreCella(3,6,0)
            If esj + 1 > EstrazioneFin Then Exit For
            Stringa2 = ""
            For pos = 1 To 5
               Stringa2 = Stringa2 & Fuori90(Vet_sv(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)
            Call CreaTabella()
            If esj + 1 > EstrazioneFin Then Exit For
            Scrivi String(75,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub
 
Ciao Baffo. Aggiunto piccolo passo, se può servire.
Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,Num1,k,kk,conta,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,Vet_contr_sv(90,5),Mat_dver_mod(21,5),Vet_contr_dv(90,5)
   Dim ruota(11)
   Dim Tabs(30)
   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"

   ruota(1) = r
   ini = 10350 ' 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
                  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
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            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
            conta = 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
               Next
            Next
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            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
               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,0)
            If esj + 1 > EstrazioneFin Then Exit For
            Stringa2 = ""
            For pos = 1 To 5
               Stringa2 = Stringa2 & Fuori90(Vet_sv(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)
            Call CreaTabella()
            If esj + 1 > EstrazioneFin Then Exit For
            Scrivi String(75,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub
 

Allegati

  • RVM.jpg
    RVM.jpg
    256,8 KB · Visite: 42
Ciao Baffo. Aggiunto piccolo passo, se può servire.
Codice:
Option Explicit
Sub Main
   Dim Vet_Controllo(90,5),Vet_ripetuti(20),pos,Num,Num1,k,kk,conta,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,Vet_contr_sv(90,5),Mat_dver_mod(21,5),Vet_contr_dv(90,5)
   Dim ruota(11)
   Dim Tabs(30)
   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"

   ruota(1) = r
   ini = 10350 ' 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
                  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
            co = co + 1
            Scrivi String(100,"°") & " Caso n°" & co,1
            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
            conta = 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
               Next
            Next
            EliminaRipetuti Vet_ripetuti
            ReDim aNum(conta)
            Scrivi
            Scrivi "Numeri ripetuti isotopi"
            For Nr = 1 To conta
               If Vet_ripetuti(Nr) > 0 And Nr <= 10 Then
                  aNum(Nr) = Vet_ripetuti(Nr)
                  Scrivi Format2(aNum(Nr)) & ".",1,False
               End If
            Next
            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
               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,0)
            If esj + 1 > EstrazioneFin Then Exit For
            Stringa2 = ""
            For pos = 1 To 5
               Stringa2 = Stringa2 & Fuori90(Vet_sv(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)
            Call CreaTabella()
            If esj + 1 > EstrazioneFin Then Exit For
            Scrivi String(75,"-"),1
            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
      Next
   Next
   Scrivi String(100,"*")
   ColoreTesto 2
   Scrivi" casi trovati : " & co,1
   ColoreTesto 0
   Scrivi String(100," * ")
   TestoInBandaPassante(" Idea e Script by Maldor/BaffoBlù"),1,3,0
End Sub
Semplicemente perfetto

Chissà se qualcuno ne verrà stimolato per una ricerca di tutt'altro genere...

che altro si potrebbe aggiungere?

Qualcuno a qualche idea in più?
 
Vedi l'allegato 2286920
Son stato sul basico ed ho giocato la sestina dei numeri ripetuti isotopi ed ha dato ambo grazie Baffo

si ti riferisci a R.I.V.

Codice:
                                         1° . 2° . 3° . 4° . 5° . 
01.06.2024 - NZ - 23.88.33.51.76 *******    .    .    .    .    . 
04.06.2024 - NZ - 60.07.62.78.38 *******    .    .    .    .    . 
06.06.2024 - NZ - 09.11.80.45.34 *******    .    .    .    .    . 
07.06.2024 - NZ - 14.68.72.42.32 ******* 14 .    .    . 42 .    . 
08.06.2024 - NZ - 76.66.47.90.24 *******    .    .    . 90 .    . 
11.06.2024 - NZ - 74.69.78.23.87 *******    .    .    . 23 .    . 
13.06.2024 - NZ - 15.03.14.10.89 *******    .    .    .    .    . 
14.06.2024 - NZ - 27.18.10.14.47 *******    .    .    .    . 47 . 
15.06.2024 - NZ - 04.55.67.56.19 *******    .    .    .    .    . 
18.06.2024 - NZ - 63.22.16.49.67 *******    .    .    .    .    . 
20.06.2024 - NZ - 14.87.40.30.47 ******* 14 .    .    .    . 47 . 
21.06.2024 - NZ - 39.81.58.23.36 *******    .    . 58 . 23 .    . 
22.06.2024 - NZ - 61.33.71.86.78 *******    .    .    .    .    . 
25.06.2024 - NZ - 40.60.58.09.27 *******    .    . 58 .    .    . 
27.06.2024 - NZ - 02.56.54.90.77 *******    .    .    . 90 .    . 
28.06.2024 - NZ - 73.35.31.70.64 *******    .    .    .    .    . 
29.06.2024 - NZ - 01.61.60.42.48 *******    .    .    . 42 .    . 

Numeri ripetuti isotopi
14.23.42.47.58.90.

°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° Caso n°6
Controllo visivo Prima/Ultima Mese 
Prima  Estrazione Mese 01.06.2024 - NZ - 23.88.33.51.76
Ultima Estrazione Mese 29.06.2024 - NZ - 01.61.60.42.48
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
Estrazione generatrice del pronostico 10466 [104 - 29/06/2024]
G 0001 Numeri in gioco : 14.23.42.47.58.90 su NZ per Estratto,Ambo
V N. [14.23.42.47.58.90             ] [NZ]     [.. 23 .. 47 ..] C.   7 Ambo       10473 [111 - 12/07/2024] [56.23.80.47.28]

In corso per altre 11 estrazioni
G 0002 Numeri in gioco : 14.23.42.47.58.90 su TT per Ambo,Terno
V N. [14.23.42.47.58.90             ] [TT] [CA][14 .. .. 47 ..] C.   1 Ambo       10467 [105 - 02/07/2024] [14.48.57.47.80]
V N. [14.23.42.47.58.90             ] [TT] [BA][.. .. 47 .. 14] C.   7 Ambo       10473 [111 - 12/07/2024] [53.67.47.41.14]
V N. [14.23.42.47.58.90             ] [TT] [CA][42 .. .. .. 23] C.   7 Ambo       10473 [111 - 12/07/2024] [42.31.17.38.23]
 
si ti riferisci a R.I.V.

Codice:
                                         1° . 2° . 3° . 4° . 5° . 
01.06.2024 - NZ - 23.88.33.51.76 *******    .    .    .    .    . 
04.06.2024 - NZ - 60.07.62.78.38 *******    .    .    .    .    . 
06.06.2024 - NZ - 09.11.80.45.34 *******    .    .    .    .    . 
07.06.2024 - NZ - 14.68.72.42.32 ******* 14 .    .    . 42 .    . 
08.06.2024 - NZ - 76.66.47.90.24 *******    .    .    . 90 .    . 
11.06.2024 - NZ - 74.69.78.23.87 *******    .    .    . 23 .    . 
13.06.2024 - NZ - 15.03.14.10.89 *******    .    .    .    .    . 
14.06.2024 - NZ - 27.18.10.14.47 *******    .    .    .    . 47 . 
15.06.2024 - NZ - 04.55.67.56.19 *******    .    .    .    .    . 
18.06.2024 - NZ - 63.22.16.49.67 *******    .    .    .    .    . 
20.06.2024 - NZ - 14.87.40.30.47 ******* 14 .    .    .    . 47 . 
21.06.2024 - NZ - 39.81.58.23.36 *******    .    . 58 . 23 .    . 
22.06.2024 - NZ - 61.33.71.86.78 *******    .    .    .    .    . 
25.06.2024 - NZ - 40.60.58.09.27 *******    .    . 58 .    .    . 
27.06.2024 - NZ - 02.56.54.90.77 *******    .    .    . 90 .    . 
28.06.2024 - NZ - 73.35.31.70.64 *******    .    .    .    .    . 
29.06.2024 - NZ - 01.61.60.42.48 *******    .    .    . 42 .    . 

Numeri ripetuti isotopi
14.23.42.47.58.90.

°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° Caso n°6
Controllo visivo Prima/Ultima Mese 
Prima  Estrazione Mese 01.06.2024 - NZ - 23.88.33.51.76
Ultima Estrazione Mese 29.06.2024 - NZ - 01.61.60.42.48
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
Estrazione generatrice del pronostico 10466 [104 - 29/06/2024]
G 0001 Numeri in gioco : 14.23.42.47.58.90 su NZ per Estratto,Ambo
V N. [14.23.42.47.58.90             ] [NZ]     [.. 23 .. 47 ..] C.   7 Ambo       10473 [111 - 12/07/2024] [56.23.80.47.28]

In corso per altre 11 estrazioni
G 0002 Numeri in gioco : 14.23.42.47.58.90 su TT per Ambo,Terno
V N. [14.23.42.47.58.90             ] [TT] [CA][14 .. .. 47 ..] C.   1 Ambo       10467 [105 - 02/07/2024] [14.48.57.47.80]
V N. [14.23.42.47.58.90             ] [TT] [BA][.. .. 47 .. 14] C.   7 Ambo       10473 [111 - 12/07/2024] [53.67.47.41.14]
V N. [14.23.42.47.58.90             ] [TT] [CA][42 .. .. .. 23] C.   7 Ambo       10473 [111 - 12/07/2024] [42.31.17.38.23]
yes sulla Nazionale
 
x maldor006 ( R.V.M_v.1.1)



Chiunque volesse intervenire con qualsiasi idea per questa nuova avventura è ben accetto.


maldor006, se ti va di continuare questa nuova pionieristica dell' R.V.M.

Le cose si fanno un po' ostiche (per me che non ho idea...)

Per te che hai l'algoritmica nel sangue penso sia un altro discorso
per quello che parlavo di future funzioni apposite...( ma parlo da quasi profano)

vado al sodo con un esempio banale ma funzionale


1.png


vedi quei due 45 in s2 ?


Una delle idee più semplici e banali per uno script iniziale che ricavi qualcosa, alla fine è questa :

(ma già prevedo futuri sviluppi...)



Stessa impostazione,

ma con le InputBox che ti fanno scegliere la Ruota e su che colonna si vuole l'analisi
s1, s2, s3, s4, s5.

InputBox per inserire il numero somma della colonna selezionata che si cerca ripetuto almeno 2 volte.

nell'esempio dell'immagine ho scelto il numero somma "45" ripetuto due volte in s2.

Andiamo nella colonna "Estratti" a sinistra e preleviamo i numeri che compongono entrambe le somme 45 in s2.

Nella Prima somma "45" in s2, i numeri in 2° posizione che la compongono sono il "12" e il "33".

Nella Seconda somma "45" in s2, i numeri in 2° posizione che la compongono sono il "24" e il "21".


12.33.21.24 (base per estratto a Ruota e per ambo a tutte)

Esiti :

al 4° colpo 12 a Bari

al 6°colpo 21-24 a Milano (Tutte)

---------------------------------------------

Stesso discorso lo si può fare nelle colonne d1, d2, d3, d4, d5. con le differenze...


di sviluppi futuri ne vedo in quantità industriale...


E' solo l'inizio di qualcosa di nuovo che solo la mia mente ormai al tramonto poteva partorire...


Ps1: spero si possa realizzare per farvi divertire in un altro modo che non si era mai visto prima...

-------------------------------------------------

Ps2: maldor, per favore, se si può fare, potresti inserire i (numeri ripetuti isotopi) in fondo alla tabella, sotto a "Somme V -90"

in pratica

Isotopi.Verticali.Ript / Ruota / Stringa dei numeri ripetuti

così si può eliminare la scritta in alto sopra la tabella ed avere tutto incluso nella tabella stessa.

grazie
 
Ciao Baffo. Ho lavorato un po' sullo script in base alle tue indicazioni. Dai un'occhiata e verifica se è quello che hai chiesto. Lo script, essendo fatto a più riprese aggiungendo varie parti, non è proprio il massimo e si potrà migliorare. Ciao, Maldor
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
   Dim Tabs(30)
   Dim ruota(11)
   Dim ruote(11)
   Dim posta(10)
   Dim poste(10)
   clp = 18
   posta(1) = 1
   posta(2) = 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: Stringa3 = ""
            For k = 1 To 90
               For kk = 1 To 5
                  If Vet_Controllo(k,kk) > 1 Then
                     conta = conta + 1
                     Vet_ripetuti(conta) = k
                     Stringa3 = Stringa3 & Vet_ripetuti(conta) & "."
                  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
               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
               Stringa2 = Stringa2 & Fuori90(Vet_sv(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
                 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
                 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
            Scrivi: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
 
Ciao Baffo. Ho lavorato un po' sullo script in base alle tue indicazioni. Dai un'occhiata e verifica se è quello che hai chiesto. Lo script, essendo fatto a più riprese aggiungendo varie parti, non è proprio il massimo e si potrà migliorare. Ciao, Maldor
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
   Dim Tabs(30)
   Dim ruota(11)
   Dim ruote(11)
   Dim posta(10)
   Dim poste(10)
   clp = 18
   posta(1) = 1
   posta(2) = 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: Stringa3 = ""
            For k = 1 To 90
               For kk = 1 To 5
                  If Vet_Controllo(k,kk) > 1 Then
                     conta = conta + 1
                     Vet_ripetuti(conta) = k
                     Stringa3 = Stringa3 & Vet_ripetuti(conta) & "."
                  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
               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
               Stringa2 = Stringa2 & Fuori90(Vet_sv(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
                 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
                 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
            Scrivi: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

Mitico maldor

Potrei scrivere un fiume di parole, ma ne bastano due :

Semplicemente Unico !

-----------------------------------------------------------

x tutti

Una nuova branca di ricerca Lotto...

Non ci si ferma al semplicistico esempio che io ho proposto e maldor realizzato in script...

Come ho già detto intravedo sviluppi futuri del tutto simili alla ricerca classica orizzontale,
ritardi, frequenze etc... tutti incentrati sulle somme, distanze S1-S5 e D1-D5,
oltre e senza escludere altre "Invenzioni" di sana pianta...

Ci vuole solo un ricercatore serio che si faccia il mazzo...(continuando gli esperimenti di ricerca)

Non pensate a me, io non ci vedo quasi più e tutto quello che vedete in giro fatto da me e solo frutto di
sforzi enormi con forza di volontà pura che ormai sta quasi agli sgoccioli...

Ormai sono al tramonto e posso solo regalarvi le ultime mie idee


un saluto a tutti
 
Ciao Baffo,

ho visto il " Like " che mi hai inserito in un mio messaggio, grazie.
Se hai letto tutto dalla prima pagina, sono sicuro che ti sarai fatto un' idea di come sono i vari ragionamenti.
Buon pomeriggio, Baffo.
 
Ciao Baffo,

ho visto il " Like " che mi hai inserito in un mio messaggio, grazie.
Se hai letto tutto dalla prima pagina, sono sicuro che ti sarai fatto un' idea di come sono i vari ragionamenti.
Buon pomeriggio, Baffo.
hi hi hi Devi capire che le persone sono come i colori, ogni pensiero porta da qualche parte...

se qualcosa ti sembra distorto in alcune parti, se ti stuzzica, tu raddrizza !

e sfrutta a tuo vantaggio... :)
 
X maldor

Scusa, ma ho notato qualcosa di anomalo
nell'estrazione generatrice del pronostico

che dovrebbe essere sempre l'ultima estrazione del mese in analisi.

nelle immagini l'ultima estrazione dalla tabella
si vede che è quella del 31/03/2012

ma nell'estrazione generatrice del pronostico c'è un altra data. (17/04/2012)
che non è l'ultima di marzo.


Anche nel controllo visivo prima/ultima estrazione non va...


ps: potresti isolare i 4 numeri dal più piccolo al più grande in modo che io possa manipolarli (sommarli /sottrarli etc...)
chessò, x1,x2,x3,x4 o quello che vuoi.
sempre se si può fare,


con quei 4 numeri vorrei fare dei giochetti Pondometrici...

grazie






a.png
b.png
 
Ciao Baffo. Avevo notato anch'io l'incongruenza ed ho sistemato il problema (penso). Cosa intendi per "isolare i quattro 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
   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
            Scrivi: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
 
Ciao Baffo. Avevo notato anch'io l'incongruenza ed ho sistemato il problema (penso). Cosa intendi per "isolare i quattro 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
   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
            Scrivi: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

rimetto l'immagine per capirci


a.png



Sono quei 4 numeri che sotto la tabella hai chiamato (Somma isotopi 39 in posizione 5) : 02-37-52-77

che sono le coppie di numeri che formano la somma 39 isotopa nella colonna di posizione 5

Questi 4 numeri li vorrei manipolare a piacere.

per quello che avevo chiesto se potevi isolarli e nominarli in qualche modo, tipo a,b,c,d oppure 1,2,3,4
o come ti pare, basta che possa prendere e fare chessò (a + b) o anche ( d + c) o quello che mi salta in testa con questi 4 elementi
e i prodotti derivanti dai calcoli.

un esempio semplice e veloce :

Na marzo 2012

colonna S5

02.37 di somma 39
52.77 di somma 39


li dispongo nel quadrato pondometrico dal più piccolo al più grande
mettendo il più piccolo in alto a destra e disponendo i numeri in senso antiorario
effettuando poi le somme


Codice:
**************************

                    79
         77................02
39      ..                     ..      39
         52................37
                    89       
      
**************************


02+37=39
37+52=89
52+77=39
77+02=79
--------------

79-39=40
89-39=50

40 e 50 come ambate semplici e determinate in 5° pos

Na : uscito 50 in 5 pos


in pratica siamo passati da 4 ambate semplici
a due ambate semplici e 2 determinate

***********************************

E' questo è solo un esempio....

l'importante è avere quei 4 numeri in mano e poterli manipolare
per ricavare la previsione finale (in modi differenti...)



grazie
 

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 20 dicembre 2024
    Bari
    19
    01
    78
    60
    05
    Cagliari
    25
    70
    87
    36
    23
    Firenze
    70
    45
    42
    37
    85
    Genova
    28
    39
    49
    41
    42
    Milano
    78
    52
    79
    85
    49
    Napoli
    10
    17
    06
    50
    04
    Palermo
    26
    40
    66
    16
    51
    Roma
    43
    26
    86
    19
    50
    Torino
    76
    38
    49
    46
    09
    Venezia
    45
    73
    56
    08
    04
    Nazionale
    79
    25
    38
    54
    72
    Estrazione Simbolotto
    Venezia
    20
    11
    02
    13
    09
Indietro
Alto