AIUTO per script

[sorujoe]

Chiedo una cortesia urgente.
A me servirebbe uno script che mi faccia questo lavoro
inserendo 2 cinquine con uno spazio tra un numero e un altro (no puntini ne trattini) lo script mi deve calcolare per ogni cinquina singola tutte le distanze ciclometriche e tutte le somme col fuori 90 ed evidenziare quelle comuni tra le 2 cinquine.
esempio
Cinquina A: 01 05 65 32 90 mi deve calcolare somme f90 e distanze ciclometriche
Cinquina B: 90 55 66 47 87 mi deve calcolare somme f90 e distanze ciclometriche

Mi deve evidenziare eventuali somme e distanza comuni tra le 2 cinquine
VI PREGO aiutatemi
Grazie

 

[sorujoe]

come sw ho spaziometria, visual lotto 7.X e lottodesk

 

[sorujoe]

spero che chi capace mi metta il listato ne ho bisogno Grazie

 

[LuigiB]

mha .. sto "VI PREGO AIUTATEMI" mi suona come uno che pensa di andare al banco e di incassare al primio colpo ..spero tanto non sia cosi ...se con il lotto si potesse vincere da quel di che avrei mandato aff..lo tutti quelli del posto dove lavoro e mi sarei ritirato al paese ...bha non divaghiamo ..
lo script dovrebbe essere semplice ma non ho capito il procedimento ogni numero deve essere sommato con gli altri 4 ? Si deve fare la differenza ciclometrica allo stesso modo ogni numero con gli altri 4 ?

 

[salvo50]

Ciao Luigi, io ho capito che per ogni cinquina vuole trovare la 10 somme col fuori90 di tutti gli ambi, poi calcolare sempre nella stessa cinquina le 10 distanze ciclometriche che si formano nei 10 ambi.

Fare gli stessi calcoli nell'altra cinquina e tra le due cinquine evidenzire i numeri in comune, la difficoltà per me è di evidenziare i numeri in comune, quindi non l'ho neanche iniziato

 

[LuigiB]

Ciao Salvo .. più o meno ho capito cosi pure io ..inoltre evidenzio pure somme e distanze nella stessa lunghetta
ecco lo script per come l'ho interpretato io naturalmente non avendo letto ulteriori specifiche spero vada bene ...
Anche se non ti trovavi ad evidenziare i valori uguali li potevi sempre scrivere ,, io in questo script
ho evidenziato somme e distanze uguali nella stessa lunghetta e ho fattto la lista scit per i valori comuni tra le distanze e le somme delle rispettive lunghette.Per come l'ho fatto le somme si confrontano con le somme e le distanze con le distanze ..

Verificare se funziona ...

ciao ...

Option Explicit
Sub Main

  Dim aL1 , aL2
  Dim aS1 ,aS2 , aD1 , aD2
  Dim b

  If GetLunghetta  ( "Inserire la prima lunghetta di 5 numeri separati da spazio" , aL1)   Then
     If GetLunghetta  ( "Inserire la seconda lunghetta di 5 numeri separati da spazio" , aL2)   Then

        Call CalcolaSomme (aL1  , aS1)
        Call CalcolaSomme (aL2  , aS2)

        Call CalcolaDistanze (aL1 , aD1)
        Call CalcolaDistanze (aL2 , aD2)

        Call MostraValoriUgualiSuLunghetta (aL1 , aS1 ,"Somme uguali su prima lunghetta " & StringaNumeri (aL1) , "Somme")
        Call MostraValoriUgualiSuLunghetta (aL2 , aS2 ,"Somme uguali su seconda lunghetta " & StringaNumeri (aL2)  , "Somme")

        Call MostraValoriUgualiSuLunghetta (aL1 , aD1 ,"Distanze uguali su prima lunghetta " & StringaNumeri (aL1) , "Distanze" )
        Call MostraValoriUgualiSuLunghetta (aL2 , aD2 ,"Distanze uguali su seconda lunghetta " & StringaNumeri (aL2), "Distanze" )


        Call MostraValoriUgualiTraLunghette ( aS1 , aS2 , "Somme uguali tra le somme" , "Somma")
        Call Scrivi
        Call MostraValoriUgualiTraLunghette ( aD1 , aD2 , "Distanze uguali tra distanze" , "Distanza")

        b = True

     End If
  End If

  If Not b Then
     MsgBox "Nessun dato elaborato"
  End If
End Sub
Function GetLunghetta (sTesto , aV)
   Dim s
   s = Trim(InputBox (sTesto   ,"Inserire i numeri") )

   ReDim aV(0)
   Do While InStr(s , "  ")
      s = Replace (s , "  " , " ")
   Loop

   Call SplitByChar(  s  , " " ,aV)
   If UBound (aV) = 4 Then  
      GetLunghetta = True

   End If
End Function
Sub CalcolaSomme  ( aL    , aSomme)
   Dim k , kk , i

   ReDim aSomme (GetCombinazioni(UBound(aL) +1))

   For k =0 To UBound (aL)-1
      For kk =k +1 To UBound (aL)
         i = i +1
         aSomme (i) = Fuori90 (Int(aL(k)) + Int(aL(kk)))
      Next

   Next
End Sub

Sub CalcolaDistanze  ( aL   , aDistanze )
   Dim k , kk , i
   ReDim aDistanze (GetCombinazioni(UBound(aL) +1))

   For k =0 To UBound (aL)-1
      For kk =k +1 To UBound (aL)
         i = i +1
         aDistanze (i) = DiffCiclometrica  (Int(aL(k)) , Int(aL(kk)))
      Next

   Next
End Sub
Function GetCombinazioni (nQNumeri)
   Dim k , t
   t =0
   For k = nQNumeri-1 To 1 Step -1
      t = t +k
   Next

   GetCombinazioni = t

End Function


Sub MostraValoriUgualiSuLunghetta (aL,aValori , sTitolo , sDescr)

   Dim k , kk , i , b
   Dim nE ,   nQ
   Dim aColori

   aColori = Array (RGB(255,128,128), RGB(255,255,128),RGB(128,255,128) ,RGB(128,255,255) ,RGB(0,128,255) ,RGB(255,128,192) ,RGB(255,128,255),RGB(255,128,0) ,RGB(128,0,255))

   nE = UBound( aValori )
   nQ = UBound(aL) +1

   ReDim aColoriCelle (nE)
   ReDim aT (11)
   ReDim aV (11)
   ReDim aBUsati(10)

   For k = 1 To nE -1
      If Not (aBUsati(k)) Then
         aBUsati (k) = True
         b = False

         For kk = k +1 To nE
            If aValori (kk) = aValori (k) Then
                aBUsati (kk) = True

                If b = False Then i = i +1
                b = True

                aColoriCelle (k) = aColori (i)
                aColoriCelle (kk) = aColori(i)
            End If

         Next
      End If

   Next

   i =0
   aT(1) = "Posizioni"
   aV(1) = sDescr
   For k = 1 To nQ-1
       For kk = k+1 To nQ
          i = i +1
          aT(i+1) = k & "-" & kk
          aV(i+1) = aValori (i)
       Next

   Next

   Call Scrivi (sTitolo , True)
   Call InitTabella ( aT ,RGB(239,239,239) )

   Call AddRigaTabella (aV )
   For k = 1 To nE
      If CLng(aColoriCelle (k)  )<> 0 Then
         Call SetColoreCella (CInt(k+1) , aColoriCelle (k))
      End If
   Next

   Call CreaTabella

End Sub

Sub MostraValoriUgualiTraLunghette (aValori1,aValori2 , sTitolo , sDescr )

   Dim k , kk , i , b
   Dim nE1 , nE2 ,   nQ
   Dim aColori

   Call Scrivi (sTitolo , True)
   Call Scrivi ("Serie 1 : " & StringaNumeri(aValori1,,True))
   Call Scrivi ("Serie 2 : " & StringaNumeri(aValori2 ,,True))
   Call Scrivi



   nE1 = UBound( aValori1 )
   nE2 = UBound( aValori2 )
   i =0

   For k =1 To nE1
      b = False
      For kk = 1 To nE2
         If aValori1(k) = aValori2(kk) Then
            If b = False Then
               b = True
               Call Scrivi (sDescr & " : " & aValori1(k) , True)
               i = i +1
            End If
            Call Scrivi ("Posizioni " & k & "-" & kk)
         End If
      Next
   Next

   If i = 0 Then Scrivi ("Nessuna")

End Sub

 

[sorujoe]

Grazie al mitico LuigiB e a Salvo50 è esattamente ciò che cercavo.
So bene quanto è bastardo il lotto grazie però dell'avviso.
Uso il tuo sw e ne sono onorato per quanto è bello potente e addirittura gratis.
Grazie di cuore

 

[LuigiB]

Di nulla Byron ... non vi abituate però gli script non li faccio di solito .. ciao ...

 

[salvo50]

Poi l'ho fatto, senza evidenziare gli uguali, ma c'è un abisso tra il mio è il tuo, come scripter io sono un granello di sabbia tu sei una galassia.

 Option Explicit
Sub Main()
   Dim Ini,Fin,Es,R1,R2
   Dim P1,P2,A,B,C,D,S1,S2,Dist1,Dist2
   Dim Casi,Riga1,Riga2,Riga3,Riga4
   Scrivi
   Ini = EstrazioneFin - 1
   Fin = EstrazioneFin
   For Es = Ini To Fin
      Messaggio Es
      AvanzamentoElab Ini,Fin,Es
      For R1 = 1 To 10
         For R2 = R1 + 1 To 12
            If R2 = 11 Then R2 = 12
            Riga1 = ""
            Riga2 = ""
            Riga3 = ""
            Riga4 = ""
            For P1 = 1 To 4
               For P2 = P1 + 1 To 5
                  A = Estratto(Es,R1,P1)
                  B = Estratto(Es,R1,P2)
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  '---------------------------------
                  S1 = Fuori90(A + B)
                  Dist1 = Distanza(A,B)
                  S2 = Fuori90(C + D)
                  Dist2 = Distanza(C,D)
                  Riga1 = Riga1 & Format2(S1) & " "
                  Riga2 = Riga2 & Format2(Dist1) & " "
                  Riga3 = Riga3 & Format2(S2) & " "
                  Riga4 = Riga4 & Format2(Dist2) & " "
               Next
            Next
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1
            Scrivi
            ColoreTesto 2
            Scrivi Space(10) & " Le dieci somme" & Space(18) & "Le dieci distanze "
            'ColoreTesto 2
            Scrivi SiglaRuota(R1),1,0
            ColoreTesto 0
            Scrivi " " & Riga1 & "    " & Riga2,1
            ColoreTesto 2
            Scrivi SiglaRuota(R2),1,0
            ColoreTesto 0
            Scrivi " " & Riga3 & "    " & Riga4,1
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub

 

[LuigiB]

bhe comunque sei sulla buona strada ... ciao ...

 

[sorujoe]

Grazie Salvo
nel tuo le cinquine non posso immetterle io comunque un buon lavoro ….ma Luigi è sommo

 

[claudio8]

Grazie Salvo
nel tuo le cinquine non posso immetterle io comunque un buon lavoro ….ma Luigi è sommo

Big gli dette l'appellativo di "Faraone", e non si era sbagliato.
A proposito Ele.. batti un colpo, so che stai pimpante, passa a trovarci, mancano molto le chiacchierate scanzonate.
saluti a tutti.

 

[salvo50]

Grazie Salvo
nel tuo le cinquine non posso immetterle io comunque un buon lavoro ….ma Luigi è sommo

Ciao a Tutti

Per farlo a immetterle, non è un problema, però servirebbe a niente, perchè non te le evidenzio, se riesco ad evidenziarle, te lo riposto con l'immessione delle cinquine

 

[sorujoe]

Thanks to all

 

[i legend]

Ciao a tutti
è sempre un piacere leggere uno script del Prof
per chi volesse utilizzare le funzioni già presenti in spaziometria c'è la funzione numeriripetutirilevatiV ( parametri )se non erro sii chiama così
ciao a tutti