Script su Metodi Cabalistici, Ciclometrici & C.

[salvo50]

Ecco lo script
salvo errori o dimenticanze

Option Explicit
Sub Main()
   Dim Es,Ini,Fin,Qua,R1,R2,P1,P2,P3,P4,P5
   Dim A,B,C,E1,E2,Casi,Caso
   Qua = InputBox("Quante estrazioni vuoi controllare? ","Controllo estrazioni",10)
   Ini = EstrazioneFin - Qua
   Fin = EstrazioneFin
   Scrivi " 2 Ruote, 3 Estratti Consecutivi, Oppure 3 estratti distanza 10, di cui 2 Isotopi",1,,4,,3,,1
   Scrivi "                    Chiesto da Everita C - Script Salvo50                        ",1,,4,,3,,1
   For Es = Ini To Fin
      Messaggio "elab. estr. del < " & DataEstrazione(Es) & " >"
      AvanzamentoElab Ini,Fin,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            For R2 = 1 To 10
               If R1 <> R2 Then
                  For P2 = 1 To 4
                     For P3 = P2 + 1 To 5
                        B = Estratto(Es,R2,P2)
                        C = Estratto(Es,R2,P3)
                        If P1 = P2 Or P1 = P3 Then
                           If(A + 1 = B And B + 1 = C) Or(A + 1 = C And C + 1 = B)_
                              Or(B + 1 = C And C + 1 = A) Or(B + 1 = A And A + 1 = C)_
                              Or(C + 1 = A And A + 1 = B) Or(C + 1 = B And B + 1 = A)_
                              Or(A + 10 = B And B + 10 = C) Or(A + 10 = C And C + 10 = B)_
                              Or(B + 10 = C And C + 10 = A) Or(B + 10 = A And A + 10 = C)_
                              Or(C + 10 = A And A + 10 = B) Or(C + 10 = B And B + 10 = A)Then
                              Casi = Casi + 1
                              Caso = Caso + 1
                              Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
                              Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
                              Scrivi
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                              For P4 = 1 To 5
                                 E1 = Estratto(Es,R1,P4)
                                 If E1 = A Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E1) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                              For P5 = 1 To 5
                                 E2 = Estratto(Es,R2,P5)
                                 If E2 = B Or E2 = C Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E2) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi
                              Scrivi
                           End If
                        End If
                     Next
                  Next
               End If
            Next
         Next
      Next
   Next
End Sub

 

[Alien.]

È EVIDENZIA TRE NUMERI CONSECUTIVI E POI !! SI FANNO SCINTILLE ?

 

[Ramco]

Ciao Salvo e tutti
..mi ha incuriosito il tuo script, a solo scopo didattico...
allego una versione diversa che agisce sulle distanze, che potrebbe ovviare a possibili errori, ed accorcia il codice di riga..
è solo uno scopo didattico per tenerci allenati, magari può servire...
PS: se è una cavolata, non tenetene conto..

Option Explicit
Sub Main()
   Dim Es,Ini,Fin,Qua,R1,R2,P1,P2,P3,P4,P5
   Dim A,B,C,E1,E2,Casi,Caso,d1,d2,d3
   Qua = InputBox("Quante estrazioni vuoi controllare? ","Controllo estrazioni",10)
   Ini = EstrazioneFin - Qua
   Fin = EstrazioneFin
   Scrivi " 2 Ruote, 3 Estratti Consecutivi, Oppure 3 estratti distanza 10, di cui 2 Isotopi",1,,4,,3,,1
   Scrivi "                    Chiesto da Everita C - Script Salvo50                        ",1,,4,,3,,1
   For Es = Ini To Fin
      Messaggio "elab. estr. del < " & DataEstrazione(Es) & " >"
      AvanzamentoElab Ini,Fin,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            For R2 = 1 To 10
               If R1 <> R2 Then
                  For P2 = 1 To 4
                     For P3 = P2 + 1 To 5
                        B = Estratto(Es,R2,P2)
                        C = Estratto(Es,R2,P3)
                        If P1 = P2 Or P1 = P3 Then
                           'distanze
                           d1 = Distanza(A,B): d2 = Distanza(A,C): d3 = Distanza(B,C)
                           If(d1 = 1 And d2 = 2) Or(d1 = 2 And d2 = 1) Or(d1 = 1 And d2 = 1) Or(d1 = 10 And d2 = 20) Or(d1 = 20 And d2 = 10) Or(d1 = 10 And d2 = 10) Then
                              If(d1 = d2 And d3 =(d1*2)) Or(d1 = d3 And d2 =(d1*2)) Or(d2 = d3 And(d1 = d2*2)) Then
                                 Casi = Casi + 1
                                 Caso = Caso + 1
                                 Scrivi String(90,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
                                 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                 For P4 = 1 To 5
                                    E1 = Estratto(Es,R1,P4)
                                    If E1 = A Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E1) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                                 For P5 = 1 To 5
                                    E2 = Estratto(Es,R2,P5)
                                    If E2 = B Or E2 = C Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi
                              End If
                           End If
                        End If
                     Next
                  Next
               End If
            Next
         Next
      Next
   Next
End Sub