Per joe o chi è capace

[solare]

Ciao, cortesemente potresti modificare questo tuo listato in modo che trovi anche gli ambi di figura ? sempre su due ruote ed isotopi.

Option Explicit
Sub Main
Dim Ini,Fin,Es,P,R1,R2,E1,E2,S,GR

'Distanze Ripetute per Solare. V.3.1 By Joe. Alba, 01/05/2016.

Ini = EstrazioneFin - 9 : Fin = EstrazioneFin
For Es = Ini To Fin : Scrivi String(21,"=") & " " & DataEstrazione(Es) & " " & String(22,"="),1
For R1 = 1 To 10 : R2 = R1 + 1 : If R2 = 11 Then R2 = 1
Scrivi SiglaRuota(R1) & "+" & SiglaRuota(R2) & " ",1,0
ReDim Nu(90)
For P = 1 To 5
E1 = Estratto(Es,R1,P) : E2 = Estratto(Es,R2,P)
S =(Distanza(E1,E2)) : Nu(S) = Nu(S) + 1
Next
For P = 1 To 5
E1 = Estratto(Es,R1,P) : E2 = Estratto(Es,R2,P)
S = Format2(Distanza(E1,E2))
If Nu(S) > 1 Then ColoreTesto 2 : GR = True
Scrivi Format2(E1) & "-" & Format2(E2) & "=" & Format2(S) & " ",GR,0 : ColoreTesto 0 : GR = False
Next
Scrivi
Next
Next
Scrivi "RUOTE ",1,0
For P = 1 To 5
Scrivi P & "' Estr. ",1,0
Next
End Sub

 

[joe]

Ciao Solare.

Prova questo nuovo script:

Option Explicit
Sub Main
    Dim Ini,Fin,Es,P1,P2,R1,R2,E1,E2,E3,E4,F1,F2,GR
    'Ambi Isotopi in Figura (x Solare). V.1.0 By Joe. Alba, 01/04/2018.
    Ini = EstrazioneFin - 155 : Fin = EstrazioneFin
    For Es = Ini To Fin
    AvanzamentoElab Ini,Fin,Es
        For R1 = 1 To 10
            For P1 = 1 To 4
                E1 = Estratto(Es,R1,P1)
                For P2 = P1 + 1 To 5
                    E2 = Estratto(Es,R1,P2)
                    F1 = Figura(E1) : F2 = Figura(E2)
                    If F1 = F2 Then
                        For R2 = R1 + 1 To 12
                            If R2 = 11 Then R2 = 12
                            E3 = Estratto(Es,R2,P1) : E4 = Estratto(Es,R2,P2)
                            If Figura(E3) = F1 And Figura(E4) = F2 Then
                                Scrivi DataEstrazione(Es) & "  ",1,0
                                Scrivi SiglaRuota(R1) & " " & Format2(E1) & "." & Format2(E2) & " >< ",0,0
                                Scrivi SiglaRuota(R2) & " " & Format2(E3) & "." & Format2(E4),0,0
                                Scrivi " (Fig " & F1 & ") [" & P1 & "°" & P2 & "°]",True
                            End If
                        Next
                    End If
                Next
            Next
        Next
        If ScriptInterrotto Then Exit For
    Next
End Sub

 

[trivellatomariotretre33]

CIAO Joe O VISTO IL TUO LISTATO interessante ........
se potresti con imput di ricerca figura a scelta, e sopratutto che la figura cercata, corrisponda in verticale orizzontale, a incrocio con la stessa distanza ti ringrazio di cuore e Auguri per la Santa Pasqua , grazie anticipatamente.

 

[solare]

Ciao joe, grazie della tua come sempre disponibilità.
Buona pasqua