Per salvo50 ,una cortesia .

[Matematico]

Un saluto a tutti, avrei bisosgno cortesemente di uno script che vada a ricercarmi terne di somma 90 in qualsiasi ruota con la particolarità che devono essere in 2/3/4 posizione .
Un esempio : NAPOLI-20/9/2018 = 08-63-23-04-74 * terna di somma 90 : 63.23.04

Ringrazio di cuore .

 

[salvo50]

Ciao a Tutti
Ciao Matematico, vedi se può andare

'Chiesto da Matematico
'Un saluto a tutti, avrei bisosgno cortesemente di uno script
'che vada a ricercarmi terne di somma 90 In qualsiasi ruota
'con la particolarità che devono essere In 2/3/4 Posizione
'script Salvo50
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,R1,P1,Es,E1,Somma
   Dim Salvo50,Caso,Casi
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,1)
   For Es = Ini To FIn
      Caso = 0
      AvanzamentoElab Ini,FIn,Es
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         A = Estratto(Es,R1,2) : If A > 0 Then
         B = Estratto(Es,R1,3)
         C = Estratto(Es,R1,4)
         Somma = Fuori90(A + B + C)
         If Somma = 90 Then
            Caso = Caso + 1
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"-") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 2
            Scrivi String(80,"-") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " ",1,0
            For P1 = 1 To 5
               E1 = Estratto(Es,R1,P1)
               If E1 = A Or E1 = B Or E1 = C Then
                  Call ColoreTesto(2)
               Else
                  Call ColoreTesto(0)
               End If
               Call Scrivi(Format2(E1) & " ",1,0)
               Call ColoreTesto(0)
            Next
            Scrivi
            Scrivi
            Scrivi Space(35) & Format2(A) & " + " & Format2(B) & " + " & Format2(C) & " = " & Format2(Somma),1
         End If
      End If
   Next
   If ScriptInterrotto Then Exit Sub
Next
End Sub

 

[Matematico]

Ciao salvo50, è semplicemente perfetto ...grazie davvero dal cuore ♥