Richiesta Modifica per I-Legend

[Xeroxs]

Buongiorno a Tutti

Tra le varie idee che ho su come cercare di utilizzare al meglio Spaziometria mentre cercavo di trovare argomenti su Array, matrici e simili, certo un enorme passo ancora per me, ma intanto volevo avvicinarmi a comprendere la materia nelle sue esposizioni, la ricerca mi ha portato ad uno script creato da I-Legend, praticamente "Un Capolavoro" nell'esporre calcoli e dati ricco di funzioni e Sub che ritengo davvero ottime

il post relativo è il seguente

Per salvo50, una cortesia

Ciao salvo50, e un saluto a tutti quelli che mi leggeranno:-) ....questo metodo mi è venuto in mente ieri qualche giorno fà:-) Vorrei testarlo con uno script , visto che i tempi con carta e penna sarebbero lunghissimi ... Ecco un esempio molto chiaro: Prendo tutti gli estratti delle prime 4...

forum.lottoced.com

al 19 esimo post hai pubblicato il tuo script relativo agli argomenti richiesti dall'utente, ciò che chiedo ad I-legend è capire come posso modificare i calcoli che chiedi alla funzione
Function GetSum(a)

che quì riporto per intero

' queesta funzione esegue i calcoli
Function GetSum(a)
Dim i
Do While UBound(a) > 1
ReDim aSom(0)
For i = 1 To UBound(a) - 1
ReDim Preserve aSom(i)
aSom(i) = Fuori90(a(i) + a(i + 1))
Next
ReDim a(0)
For i = 1 To UBound(aSom)
ReDim Preserve a(i)
a(i) = aSom(i)
Next
Scrivi StringaNumeri(a,,True)
Loop
GetSum = a(UBound(a))
End Function


dove dopo aver caricato gli estratti scelti viene fatta la somma tra il 1 ed 2 estratto e poi tra il 2 ed il 3 e così via,
la mia richiesta si basa sul fatto che vorrei semplicemente eseguire la somma degli estratti scelti, ad esmpios supponiamo di aver scelto i primi 3 estratti di Bari che quì riporto frutto di fantasia 20 32 40
il calcolo da eseguire sarà 20+32+40 = 2 con il fuori 90

Io ci ho provato in diversi modi ma evidentemente molte sono le cose concatenate alle function ed alle sue regole.

Lo Chiedo a Te I-Legend visto che è opera Tua, sperando che sia possibile e che Tu abbia voglia di Aiutarmi in questa mia richiesta.


Di seguito riporto lo script per intero

Option Explicit
' Verificare che i risultati ottenuti siano esatti o conformi a quanto richiesto
' Selezione di n estratti a cui applicare il calcolo somma consecutiva
' script per matematico utente ced
Sub Main
   Dim idEstr
   Dim aPos(55,2)
   ReDim aEstrVer(0)
   Dim sEstr
   ReDim aR(0):Call ScegliMyRuote(aR)
   Dim aRT(1):aRT(1) = 11
   Call ScegliEstratti(aEstrVer,aPos,sEstr)
   ReDim aNum(0)
   Dim aAmb(2),aP1(1),aP2(2):aP1(1) = 1:aP2(2) = 1
   Dim qEstr:qEstr = CInt(InputBox("minimo 1 ","inserisci quanti concorsi analizzare",1)) ' analizzo gli ultimi 20 concorsi si puo cambiare
   If qEstr < 1 Then Exit Sub
   Dim nClp:nClp = 9 ' numero colpi di verifica
   Dim aVCap:aVCap = Array("Complemento a 90","Simmetrico a 91","Diamterale","Vertibile","Diametrale Decina")
   Dim idCap:idCap = ScegliOpzioneMenu(aVCap,0,"Calcola il .... del primo capogioco") + 1
   Dim Ini,fin
   fin = EstrazioneFin
   Ini = fin -(qEstr - 1)
   For idEstr = Ini To fin
      Scrivi FormatSpace(GetInfoEstrazione(idEstr) & "   " & sEstr,60,1) & "  ",1,,vbBlue,vbCyan ' informazioni data e ruote
      Call CaricaAEstr(idEstr,aPos,aEstrVer,aNum)
      Scrivi StringaNumeri(aNum,,True)
      aAmb(1) = GetSum(aNum) ' numero ottenuto dal calcolo
      Select Case idCap
      Case 1
         aAmb(2) = 90 - aAmb(1) ' secondo numero ottenuto come complemento 90 dell ambata principale
      Case 2
         aAmb(2) = 91 - aAmb(1) ' simmetrico 91
      Case 3
         aAmb(2) = Diametrale(aAmb(1))
      Case 4
         aAmb(2) = Vert(aAmb(1)) ' vertibile
      Case 5
         aAmb(2) = DiametraleD(aAmb(1)) ' diametrale decina
      End Select
      Scrivi FormatSpace(GetInfoEstrazione(idEstr) & "   " & StringaRuote(aR) & "  " & FormatSpace(GetSum(aNum),2,1) & "  " & StringaNumeri(aAmb,,True),60,1) & "  ",1,,vbBlue,vbCyan
      Call ImpostaGiocata(1,aAmb,aR,aP1,nClp)
      Dim aSestina:aSestina = Array(0,aAmb(1),aAmb(2),Fuori90(aAmb(1) + 1),Fuori90(aAmb(1) - 1),Fuori90(aAmb(2) + 1),Fuori90(aAmb(2) - 1))
      Call ImpostaGiocata(2,aSestina,aRT,aP2,nClp)
      Call Gioca(idEstr)
      Call AvanzamentoElab(Ini,fin,idEstr)
   Next
   Scrivi FormatSpace(" ",62),1,,RGB(0,128,64),RGB(236,255,245)
   Scrivi FormatSpace("  Hai scelto come Secondo capaogioco il :  " & aVCap(idCap - 1),62),1,,RGB(0,128,64),RGB(236,255,245)
   Scrivi FormatSpace(" ",62),1,,RGB(0,128,64),RGB(236,255,245)
   ScriviResoconto
End Sub
' questa sub carica gli estratti su cui effettuare i calcoli
Sub CaricaAEstr(idestr,aPos,aEstrVer,anum)
   Dim R,k,p,E
   k = 0
   ReDim anum(0)
   For p = 1 To UBound(aEstrVer)
      E = Estratto(idestr,aPos(aEstrVer(p),1),aPos(aEstrVer(p),2))
      If isNumeroValidoLotto(E) Then
         ReDim Preserve anum(p)
         anum(p) = Estratto(idestr,aPos(aEstrVer(p),1),aPos(aEstrVer(p),2))
      End If
   Next
End Sub
' queesta funzione esegue i calcoli
Function GetSum(a)
   Dim i
   Do While UBound(a) > 1
      ReDim aSom(0)
      For i = 1 To UBound(a) - 1
         ReDim Preserve aSom(i)
         aSom(i) = Fuori90(a(i) + a(i + 1))
      Next
      ReDim a(0)
      For i = 1 To UBound(aSom)
         ReDim Preserve a(i)
         a(i) = aSom(i)
      Next
      Scrivi StringaNumeri(a,,True)
   Loop
   GetSum = a(UBound(a))
End Function
Sub ScegliEstratti(aEstrVer,aPos,sEstr)
   ReDim aVoci(55)
   ReDim aVociSel(55)
   Dim R,m,p
   For R = 1 To 12
      If R = 11 Then R = 12
      For p = 1 To 5
         m = m + 1
         aVoci(m) = p & SiglaRuota(R)
         aPos(m,1) = R
         aPos(m,2) = p
      Next
   Next
   m = 0
   sEstr = ""
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Estratti di Verifica") >= 0 Then
      For p = 1 To UBound(aVoci)
         If aVociSel(p) Then
            m = m + 1
            ReDim Preserve aEstrVer(m)
            aEstrVer(m) = p
            sEstr = sEstr & aVoci(p) & "  "
         End If
      Next
   End If
End Sub
Sub ScegliMyRuote(aRuVer)
   ReDim aVoci(10)
   ReDim aVociSel(10)
   Dim k,m
   For k = 0 To 10
      m = m + 1
      If m = 11 Then m = 12
      aVoci(k) = NomeRuota(m)
   Next
   m = 0
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Ruota/e per capogiochi") >= 0 Then
      For k = 0 To UBound(aVoci)
         If aVociSel(k) Then
            m = m + 1
            ReDim Preserve aRuVer(m)
            aRuVer(m) = k + 1
            If aRuVer(m) = 11 Then aRuVer(m) = 12
         End If
      Next
   End If
End Sub

Grzaie come sempre

 

[i legend]

Dim aNum(3)
Dim r:r=1
Dim i
Dim sum

Redim aEstr(0)
Calle getarraynumeriruota(ideate,r,aEstr)
Anum(1)= aestr(1)
Anum(2)= aestr(2)
Anum(3)=aestr(3)
Sum=0
For i=1 to ubound(anum)
Sum=sum+anum(i)
Next
Scrivi sul

Semplice
Ora per agevolarti il lavoro costruisci una funzione che ti scelga le posizioni che vuoi sommare senza intervenire sempre sullo script
Ciao
Scusa ma ho appena finito di lavorare e scrivo da cell , controlla che non ci siano errori

 

[Xeroxs]

Grazie I-Legend, Provo

 

[Xeroxs]

Ciao, I-legend
Nel week end ci ho provato in ogni modo a sviluppare un qualcosa che desse senso alla somma degli estratti, volendo utilizzare lo stesso tuo listato e modificando solo il tipo di calcolo in questo caso la somma pura degli estratti, cercando di non modificare i vari termini tipo i valori di "a" ed "i" con le Dim e poi nella funzione ma nulla, ho cercato di capire il funzionamento della tua funzione e li ok, ma per modificarla purtroppo non è ancora alla mia portata,
sto cercando argomenti sulle funzioni e gli Array molto ma molto comodi ma ne devo ancora assorbire i vari meccanismi.

Per Cui devo chiederti se Vuoi e quando Puoi di intervenire per ottenere quanto Vorrei.
Ovvio senza impegno, continuerò in questa operazione ma evidentemente sono ancora ad un livello che non mi permette di agire forse troppi i legami dei codici.... vedremo

Intanto grazie come sempre

 

[i legend]

Ciao xerox la soluzione della somma è al post 2 .
Non so cosa vuoi ottenere, e se lo script lo possa fare .
Esso nasce da una richiesta specifica di un utente, che aveva un idea Chiara di quello che voleva .
Per me fare uno script, era utile per impegnare la mente. Non importava il tempo che ci impiegavo.,era importante la sfida. Mi sembrava di aver capito che anche per te dovrebbe essere la stessa cosa. Hai la soluzione ,divertiti nel trovare il modo di incastrarla. Se invece ti serve subito ,domani quando finisco di lavorare ti posto le modifiche .
Ciao

 

[i legend]

Oggi non ho il PC.

 

[Xeroxs]

Ciao, I-Legend Non Mi serve Subito, anzi
Cerco di Riprovare
Grazie