Richiesta script "DISTANZA 40 SU RUOTA"

[vinci]

Servirebbe uno script per spaziometria che ricavi dei numeri su ruota.

ITER OPERATIVO :

In qualsiasi estrazione del mese individuare su singola ruota due coppie
di numeri tutti differenti tra di loro che abbiano in comune la stessa distanza ciclometrica 40.
Fare le somme in orizzontale, verticale e in diagonale.
Mettere in gioco i 5 numeri ricavati (una coppia di numeri sarà sempre uguale tra di loro)
per ambo, terno, quaterna e cinquina per i 10 colpi successivi.

Esempio pratico:
estrazione del 05/05/2016 sulla ruota di
FIRENZE venivano estratti i numeri
36-76-04-64-44
distanza ciclometrica tra il 1° e 2° estratto (36-76) uguale a 40
distanza ciclometrica tra il 3° e 5° estratto (04-44) uguale a 40
somme verticali 40 e 30
somme orizzontali 22 e 48
somme diagonali 80 e 80
Previsione
FIRENZE 22-30-40-48-80
esito:
al 1° colpo in data 07/05/2016
FIRENZE 40-48-80 terno


Grazie a chi potrà aiutarmi,
ciao

 

[Mike58]

Ciao Vinci, condizione non facile a trovarsi ed Esito non soddisfacente.

Controllare errori ed omissioni

Sub Main
 Dim Nu(2),aN(2),Ru(1),nP(6)
 Ini = EstrazioneFin - 400
 fin = EstrazioneFin
 For es = Ini To fin
  For r1 = 1 To 12
   If r1 = 11 Then r1 = 12
   For p1 = 1 To 4
    For p2 = p1 + 1 To 5
     a = Estratto(es,r1,p1)
     b = Estratto(es,r1,p2)
     For p3 = p2 + 1 To 4
      For p4 = p3 + 1 To 5
       c = Estratto(es,r1,p3)
       d = Estratto(es,r1,p4)
       Nu(1) = a
       Nu(2) = b
       aN(1) = c
       aN(2) = d
       Ru(1) = r1
       If Nu(1) <> aN(1) And Nu(1) <> aN(2) And Nu(2) <> aN(1) And Nu(2) <> aN(2) Then
        If Distanza(Nu(1),Nu(2)) = 40 Then
         If Distanza(aN(1),aN(2)) = 40 Then
          k = k + 1
          nP(1) = Fuori90(Nu(1) + aN(1))
          nP(2) = Fuori90(Nu(2) + aN(2))
          nP(3) = Fuori90(Nu(1) + Nu(2))
          nP(4) = Fuori90(aN(1) + aN(2))
          nP(5) = Fuori90(Nu(1) + aN(2))
          nP(6) = Fuori90(Nu(2) + aN(1))
          EliminaRipetuti(nP)
          Call VerificaEsito(nP,Ru,es + 1,2,15,,,clp,es1,id)
          Scrivi GetInfoEstrazione(es) & vbTab,0,0
          Scrivi SiglaRuota(r1) & vbTab,0,0
          Scrivi StringaEstratti(es,r1) & vbTab,0,0
          Scrivi StringaNumeri(Nu,,1) & vbTab & vbTab & p1 & p2 & vbTab,0,0
          Scrivi StringaNumeri(aN,,1) & vbTab & vbTab & p3 & p4 & vbTab,0,0
          Scrivi StringaNumeri(nP,,1) & vbTab,0,0
          Scrivi "Clp : " & FormatSpace(clp,2) & vbTab & es1,1,,,2,3,,1
         End If
        End If
       End If
      Next
     Next
    Next
   Next
  Next
 Next
 Scrivi "Casi Trovati : " & k,1
End Sub

 

[vinci]

Grazie Mike per il lavoro richiesto, mi ero riferito a quella situazione di un anno fa che aveva dato il terno,
purtroppo la statistica dice tutta un altra cosa.

 

[franca46]

ciao Vinci , mi hai fatto venire un'idea!!!

guarda cos ho fatto :

Sub Main
 Dim Nu(2),aN(2),Ru(1),nP(6)
 Ini = EstrazioneFin - 400
 fin = EstrazioneFin
 For es = Ini To fin
  For r1 = 1 To 12
   If r1 = 11 Then r1 = 12
   For p1 = 1 To 4
    For p2 = p1 + 1 To 5
     a = Estratto(es,r1,p1)
     b = Estratto(es,r1,p2)
     For p3 = p2 + 1 To 4
      For p4 = p3 + 1 To 5
       c = Estratto(es,r1,p3)
       d = Estratto(es,r1,p4)
       Nu(1) = a
       Nu(2) = b
       aN(1) = c
       aN(2) = d
       Ru(1) = r1
       If Nu(1) <> aN(1) And Nu(1) <> aN(2) And Nu(2) <> aN(1) And Nu(2) <> aN(2) Then
        If Distanza(Nu(1),Nu(2)) = Distanza(aN(1),aN(2)) Then
         'If Distanza(aN(1),aN(2)) = 40 Then
          k = k + 1
          nP(1) = Fuori90(Nu(1) + aN(1))
          nP(2) = Fuori90(Nu(2) + aN(2))
          nP(3) = Fuori90(Nu(1) + Nu(2))
          nP(4) = Fuori90(aN(1) + aN(2))
          nP(5) = Fuori90(Nu(1) + aN(2))
          nP(6) = Fuori90(Nu(2) + aN(1))
          EliminaRipetuti(nP)
          Call VerificaEsito(nP,Ru,es + 1,2,15,,,clp,es1,id)
          Scrivi GetInfoEstrazione(es) & vbTab,0,0
          Scrivi SiglaRuota(r1) & vbTab,0,0
          Scrivi StringaEstratti(es,r1) & vbTab,0,0
          Scrivi StringaNumeri(Nu,,1) & vbTab & vbTab & p1 & p2 & vbTab,0,0
          Scrivi StringaNumeri(aN,,1) & vbTab & vbTab & p3 & p4 & vbTab,0,0
          Scrivi StringaNumeri(nP,,1) & vbTab,0,0
          Scrivi "Clp : " & FormatSpace(clp,2) & vbTab & es1,1,,,2,3,,1
         End If
        End If
       'End If
      Next
     Next
    Next
   Next
  Next
 Next
 Scrivi "Casi Trovati : " & k,1
End Sub

controlla !!!

 

[vinci]

Grazie Franca, lavoro interessante !