3 ambi isotopi con la stessa distanza

[Cronos306090]

Buone Feste a tutti gli Amici del forum. Chiedo una gentilezza agli scripter , di crearne uno che sia capace di rilevare 3 ambi isotopi aventi la stessa distanza e nella stessa estrazione. Grazie fin d'ora per l'attenzione. Allego un esempio.

 

[salvo50]

Ciao a Tutti.
Ciao Cronos

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,E,F,Salvo50,Es
   Dim R1,R2,R3,P1,P2,P5,P6,P7,E1,E2,E3
   Dim DiAB,DiCD,DiEF,Caso,Casi
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,8850))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(3) & " Chiesto da Cronos306090 - 3 Ambi Isotopi Stessa Distanza - script Salvo50",1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               DiAB = Distanza(A,B)
               For R2 = R1 + 1 To 10
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  DiCD = Distanza(C,D)
                  If DiAB = DiCD Then
                     For R3 = R2 + 1 To 12
                        If R3 = 11 Then R3 = 12
                        E = Estratto(Es,R3,P1)
                        F = Estratto(Es,R3,P2)
                        DiEF = Distanza(E,F)
                        If DiEF = DiAB Then
                           If A > 0 And C > 0 And E > 0 Then
                              Caso = Caso + 1
                              Casi = Casi + 1
                              Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),,,,7
                              Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),,,,1
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R1) & " ",1,0
                              For P5 = 1 To 5
                                 E1 = Estratto(Es,R1,P5)
                                 If E1 = A Or E1 = B Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E1) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiAB)
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R2) & " ",1,0
                              For P6 = 1 To 5
                                 E2 = Estratto(Es,R2,P6)
                                 If E2 = C Or E2 = D Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E2) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiCD)
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R3) & " ",1,0
                              For P7 = 1 To 5
                                 E3 = Estratto(Es,R3,P7)
                                 If E3 = E Or E3 = F Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E3) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiEF)
                           End If
                        End If
                     Next
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub

 

[Cronos306090]

Ciao a Tutti.
Ciao Cronos

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,E,F,Salvo50,Es
   Dim R1,R2,R3,P1,P2,P5,P6,P7,E1,E2,E3
   Dim DiAB,DiCD,DiEF,Caso,Casi
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,8850))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(3) & " Chiesto da Cronos306090 - 3 Ambi Isotopi Stessa Distanza - script Salvo50",1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               DiAB = Distanza(A,B)
               For R2 = R1 + 1 To 10
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  DiCD = Distanza(C,D)
                  If DiAB = DiCD Then
                     For R3 = R2 + 1 To 12
                        If R3 = 11 Then R3 = 12
                        E = Estratto(Es,R3,P1)
                        F = Estratto(Es,R3,P2)
                        DiEF = Distanza(E,F)
                        If DiEF = DiAB Then
                           If A > 0 And C > 0 And E > 0 Then
                              Caso = Caso + 1
                              Casi = Casi + 1
                              Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),,,,7
                              Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),,,,1
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R1) & " ",1,0
                              For P5 = 1 To 5
                                 E1 = Estratto(Es,R1,P5)
                                 If E1 = A Or E1 = B Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E1) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiAB)
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R2) & " ",1,0
                              For P6 = 1 To 5
                                 E2 = Estratto(Es,R2,P6)
                                 If E2 = C Or E2 = D Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E2) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiCD)
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi " " & SiglaRuota(R3) & " ",1,0
                              For P7 = 1 To 5
                                 E3 = Estratto(Es,R3,P7)
                                 If E3 = E Or E3 = F Then
                                    ColoreTesto 2
                                 Else
                                    ColoreTesto 0
                                 End If
                                 Scrivi Format2(E3) & " ",1,0
                                 ColoreTesto 0
                              Next
                              Scrivi " <--  Evidenziati Distanza " & Format2(DiEF)
                           End If
                        End If
                     Next
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub

Sempre grande Salvo50 ! Grazie ancora per la tua puntualita'! io cerco di ricambiare postando previsioni su questo forum che possano dare soddisfazione grazie anche ai vostri script!