Legend - NUOVA MISSIONE

i legend · 21 Dicembre 2015

ciao luigi a me funziona correttamente per tutte le ruote
basta togliere gli apici all if per vedere la differenza
dove è l errore?
Adomani

scusa ero incollato alla tv....
Perche non fanno un film su goldrake?
se lo googli puoi capire

Codice:

Option Explicit
Sub Main
    Dim aEstrArcReale
    Dim idEstrAR,idEstrAV,nn
    Dim r,e
    If AlimentaMatriceEst(aEstrArcReale) Then
        For idEstrAR = 1 To 1
            idEstrAV = idEstrAV + 1
            nn = 1
            ReDim aEstrV(11,5)
            For r = 1 To 11
                For e = 1 To 5
                    'If Int(aEstrArcReale(idEstrAR,r,1)) > 0 Then
                        aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)
                    'Else
                        'aEstrV(r,e) = aEstrArcReale(idEstrAR,r,e)
                    'End If
                Next
            Next
        Next
    End If
    ScriviMatrice(aEstrV)
End Sub
Function AlimentaMatriceEst(aEst)
    ' alimenta la matrice con tutte le estrazioni dell'archivio reale
    Dim k,r,e,nTot
    nTot = EstrazioniArchivio
    ReDim aEst(nTot,11,5)
    For k = 1 To nTot
        ReDim aNumEst(0)
        Call GetEstrazioneCompleta(k,aNumEst)
        aEst(k,0,0) = DataEstrazione(k,,,"/") & "-" & IndiceAnnuale(k)
        For r = 1 To 11
            For e = 1 To 5
                aEst(k,r,e) = aNumEst(r,e)
            Next
        Next
    Next
    AlimentaMatriceEst = nTot > 0
End Function

LuigiB · 21 Dicembre 2015

Ciao Legend testare solo la prima posizione è corretto ...se lo si fa fuori dal ciclo delle posizioni....

i legend · 21 Dicembre 2015

Capo Chino e Guanciotte Rosse
Che vergogna

ciao

LuigiB · 21 Dicembre 2015

Ciao Legend .. tranne l'increscioso errorore

per il resto ti è tutto chiaro ? Ora che gli archivi virtuali sono stati creati e abbiamo pure aggiunto le caratteristiche richieste da Mirapep che in un 'ottica di "faccciamo finta che è vero" hanno sicuramente un loro perche possiamo procedere con il resto dello script.

i legend · 21 Dicembre 2015

Ok.
Si procede.
Scusa se mi collego un po meno ,per il momento i tempi non sono sincroni ma ci sono.
Grazie posta gli input quando vuoi

Buona notte

Rosanna · 21 Dicembre 2015

LuigiB;n1945564 ha scritto:
ciao a tutti , ciao a Rosanna che ci segue da dietro le quinte .. anche se non puoi immergerti nell'intero script ma hai lo stesso qualche domanda chiedi pure .. siamo qua ..

Si si grazie.... ma sarà difficile fare domande appropriate stando dietro le quinte.
Buon lavoro e buone feste

LuigiB · 22 Dicembre 2015

Ok ..come facciamo a far creare anche quell archivio che nel progetto Svp si chiama d90 ?

i legend · 22 Dicembre 2015

Ciao Luigi ci penso su .
Considerando che i sistemi virtuali sono 25 ossia 24+1
penso dovremmo intervenire
sulla riga do while o creare un if ma ci penso per bene....
se faccio le cose velocemente(risultato finale) le faccio alla carlona e non va bene, devo imparare...
poi con il natale tutto diventa frenetico e sembra impossibile rilassarsi un attimo e trovare 10 minuti per se....
Ciao a dopo

LuigiB · 22 Dicembre 2015

Legend attenzione qui di archivi ne possiamo fare quanti ne vogliamo non solo 25....quindi il nostro d90 e meglio chiamatlo 00000...e per crearlo c e un modo molto semplice che non snatura lo script....

i legend · 22 Dicembre 2015

ciao Luigi l ho fatto nella maniera piu semplice che ho trovato
ho aggiunto solo 4 righe di codice, ma sicuramente non è elegante
,bhe quando lo leggi capisci perche dico questo.
sono curioso di vedere come hai fatto te.
ovviamente sono curioso se ci sono anche altre soluzioni.
Rosanna se vuoi partecipare a luigi fa piacere e anche a me e a tutti quelli che come me vogliono imparare.
ciao

Codice:

Sub Main
    Dim aKey ' array delle chiavi per creare gli archivi virtuali
    Dim nQArchivi ' quantita degli archivi da creare
    Dim nEstrIni ' estrazione dalla quale iniziare a creare le corrispondenti virtuali
    Dim nClasseChiave ' classe per la chiave degli archivi
    Dim sFileChiavi ' file che memorizza le chiavi per gli n archivi virtuali
    Dim aEstAR ' matrice estrazioni archivio reale (Tot,Ruota,Pos)
    Dim sDirArcVirt ' directory dove vengono creati gli archivi virtuali
    Dim nRitMaxMin,nRitMaxMax ' rang emin e max per accettare il ritmax per estratto sul nuovo archivio prodotto
    Dim nRitRelMaxMin,nRitRelMaxMax ' rang emin e max per accettare il ritmax per estratto sul nuovo archivio prodotto
    Dim percVarRitMax ' percentuale di variazione +/- per calcolare il range rispetto al ritmax calcolato su archivio reale
    Dim nQEstrArcReale ' quantita estrazioni in archivio reale
    percVarRitMax = 20
    nQArchivi = GetQuantitaArchivi
    nClasseChiave = ScegliClasse
    nEstrIni = ScegliInizio
    sDirArcVirt = GetDirectoryAppData & "ArcVirtEnigma\"
    nQEstrArcReale = EstrazioniArchivio
    If VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni) Then
        ' creo la directry dove salvo gli archivi
        If CreaDirectory(sDirArcVirt) Then
            ' legge le estrazioni dell'archivio reale e le mette in memoria
            If AlimentaMatriceEst(aEstAR) Then
                Call GetRangeMinMaxRitardoMax(percVarRitMax,nEstrIni,nRitMaxMin,nRitMaxMax)
                Call GetRangeMinMaxRitardoRelMax(percVarRitMax,nEstrIni,nRitRelMaxMin,nRitRelMaxMax)
                Call CreaArchiviVirtuali(nQArchivi,nClasseChiave,nEstrIni,aEstAR,nQEstrArcReale,sDirArcVirt,nRitMaxMin,nRitMaxMax,nRitRelMaxMin,nRitRelMaxMax)
                Call ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
            End If
        End If
    End If
End Sub
Function VerificaCoerenza(nQArchivi,nClasseChiave,nEstrIni)
    Dim sMsg
    If nQArchivi <= 0 Then sMsg = "Specificare la quantita di archivi da creare"
    If nClasseChiave <= 4 Then sMsg = "Specificare la classe per le chiavi di generazione"
    If nEstrIni <= 0 Then sMsg = "Specificare l'estrazione di partenza per la generazione degli archivi"
    If sMsg <> "" Then
        MsgBox sMsg,vbCritical
    Else
        VerificaCoerenza = True
    End If
End Function
Function ScegliInizio()
    ReDim aV(EstrazioniArchivio)
    Dim k
    For k = 1 To UBound(aV)
        aV(k) = GetInfoEstrazione(k)
    Next
    ScegliInizio = ScegliOpzioneMenu(aV,1,"Inizio archivio virtuale")
End Function
Function ScegliClasse
    ReDim aV(16)
    Dim k
    For k = 5 To 20
        aV(k - 4) = k
    Next
    ScegliClasse =(ScegliOpzioneMenu(aV,1,"Classe chiavi di generazione")) + 4
End Function
Function GetQuantitaArchivi
    GetQuantitaArchivi = Int(InputBox("Quanti archivi virtuali creare ?","Quantita archivi virtuali","25"))
End Function
Function AlimentaMatriceEst(aEst)
    ' alimenta la matrice con tutte le estrazioni dell'archivio reale
    Dim k,r,e,nTot
    nTot = EstrazioniArchivio
    ReDim aEst(nTot,11,5)
    For k = 1 To nTot
        ReDim aNumEst(0)
        Call GetEstrazioneCompleta(k,aNumEst)
        aEst(k,0,0) = DataEstrazione(k,,,"/") & "-" & IndiceAnnuale(k)
        For r = 1 To 11
            For e = 1 To 5
                aEst(k,r,e) = aNumEst(r,e)
            Next
        Next
    Next
    AlimentaMatriceEst = nTot > 0
End Function
Function GetFileCfgArchivio(sDirArc,nIdEstrIni,nClasse,nQArc)
    GetFileCfgArchivio = sDirArc & "CFG_" & nIdEstrIni & "_" & nClasse & "_" & nQArc & ".dat"
End Function
Function GetFileArchivioVirt(sDirArc,nIdEstrIni,nClasse,nQArc,nIdArc)
    GetFileArchivioVirt = sDirArc & "BDV" & FormattaStringa(nIdArc,"00000") & "_" & nClasse & "_" & nIdEstrIni & "_" & nQArc & ".dat"
End Function
Function GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,nEstrInizio)
    Dim n,r,nRitMax,nMax
    ReDim aN(1)
    ReDim aR(1)
    nRetNum = 0
    nRetRuota = 0
    For r = 1 To 10
        aR(1) = r
        If r <> 11 Then
            For n = 1 To 90
                aN(1) = n
                ' usare la funzione turbo solo dalla versione 1.5.73
                Call StatisticaFormazioneTurbo(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                'Call StatisticaFormazione(aN,aR,1,0,nRitMax,0,0,nEstrInizio,EstrazioniArchivio)
                If nRitMax > nMax Then
                    nMax = nRitMax
                    nRetNum = n
                    nRetRuota = r
                End If
            Next
        End If
    Next
    GetRitardoMaxEstrattoArchivio = nMax
End Function
Sub GetRangeMinMaxRitardoMax(PercVariazione,nEstrIni,nRetMin,nRetMax)
    Dim nRitMax
    Dim nValue,nRetNum,nRetRuota
    nRitMax = GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,nEstrIni)
    nValue = ProporzioneX(PercVariazione,100,nRitMax)
    nRetMin = nRitMax - nValue
    nRetMax = nRitMax + nValue
    Call Scrivi("Ritardo massimo su archivio reale estrazione inizio " & nEstrIni)
    Call Scrivi("Sono accettati gli archivi che si discostano del " & PercVariazione & "% rispetto al ritardo sull'archivio reale")
    Call Scrivi("Ritardo massimo Min " & nRetMin)
    Call Scrivi("Ritardo massimo Max " & nRetMax)
    Call Scrivi
    ReDim av(3)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    Call InitTabella(av,vbYellow)
    av(1) = nRetNum
    av(2) = NomeRuota(nRetRuota)
    av(3) = nRitMax
    Call AddRigaTabella(av)
    Call CreaTabella
End Sub
Sub GetRangeMinMaxRitardoRelMax(PercVariazione,nEstrIni,nRetMin,nRetMax)
    Dim nRitMax
    Dim nValue,nRetNum,nRetRuota
    nRitMax = GetRitRelMaxArchivio(nEstrIni,EstrazioniArchivio,nRetNum,nRetRuota)
    nValue = ProporzioneX(PercVariazione,100,nRitMax)
    nRetMin = nRitMax - nValue
    nRetMax = nRitMax + nValue
    Call Scrivi("Ritardo relativo massimo su archivio reale estrazione inizio " & nEstrIni)
    Call Scrivi("Sono accettati gli archivi che si discostano del " & PercVariazione & "% rispetto al ritardo sull'archivio reale")
    Call Scrivi("Ritardo Rel massimo Min " & nRetMin)
    Call Scrivi("Ritardo Rel massimo Max " & nRetMax)
    Call Scrivi
    ReDim av(3)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo rel max"
    Call InitTabella(av,vbYellow)
    av(1) = nRetNum
    av(2) = NomeRuota(nRetRuota)
    av(3) = nRitMax
    Call AddRigaTabella(av)
    Call CreaTabella
End Sub
Function GetRitRelMaxArchivio(Inizio,fine,nRetNumRitRelMax,nRetRuotaRitRelMax)
    Dim r,k
    ReDim aRuote(1)
    Dim nRitRel,nRitRelMax
    nRetNumRitRelMax = 0
    nRetRuotaRitRelMax = 0
    Call Messaggio("Calcolo ritardo relativo massimo")
    For r = 1 To 10
        aRuote(1) = r
        Call InitCalcoloRitRel(aRuote,Inizio,fine)
        For k = 1 To 90
            nRitRel = GetRitRelMax(k,Inizio + 220,fine)
            If nRitRel > nRitRelMax Then
                nRitRelMax = nRitRel
                nRetNumRitRelMax = k
                nRetRuotaRitRelMax = r
            End If
        Next
        Call AvanzamentoElab(1,10,r)
        If ScriptInterrotto Then Exit For
    Next
    GetRitRelMaxArchivio = nRitRelMax
End Function
Sub LeggiChiaviDaFile(sFileChiavi,aKey)
    Dim k
    ' legge le chiavi per la creazione degli archivi virtuali
    ' potrebbe pure non leggere le chiavi se il file non esiste
    For k = 1 To UBound(aKey)
        aKey(k) = ""
    Next
    If FileEsistente(sFileChiavi) Then
        ReDim aRighe(0)
        Call LeggiRigheFileDiTesto(sFileChiavi,aRighe)
        For k = 0 To UBound(aRighe)
            aKey(k + 1) = aRighe(k)
        Next
    End If
End Sub
Sub MischiaColonna(aCol)
    Dim nUpper
    Dim nFatti
    Dim nPos,nPosOrig
    nUpper = UBound(aCol)
    ReDim aB(nUpper)
    ReDim aNewCol(nUpper)
    Do While nFatti < nUpper
        nPos = NumeroCasuale(1,nUpper)
        Do While aB(nPos)
            nPos = NumeroCasuale(1,nUpper)
        Loop
        aB(nPos) = True
        nPosOrig = nPosOrig + 1
        aNewCol(nPosOrig) = aCol(nPos)
        nFatti = nFatti + 1
    Loop
    For nPos = 1 To nUpper
        aCol(nPos) = aNewCol(nPos)
    Next
End Sub
Sub CreaArchiviVirtuali(nQArchivi,nClasseKey,nEstrIni,aEstrArcReale,nQEstrAR,sDirArchivi,nRitMaxMin,nRitMaxMax,nRitRelMaxMin,nRitRelMaxMax)
    Dim sFileArc
    Dim k,r,e
    Dim nQEstrInArcV
    Dim idEstrAR,idEstrAV
    Dim nPosKey
    Dim nn
    Dim nSalv
    Dim nArcCreati
    Dim bCalcRitMax
    Dim nTmpNumArc
    Dim nRitMax,nRitRelMax
    Dim sTmpCol
    Dim coll
    Dim sFileChiavi
    Dim bEliminaFileArc
    Set coll = GetNewCollection
    sFileChiavi = GetFileCfgArchivio(sDirArchivi,nEstrIni,nClasseKey,nQArchivi)
    If FileEsistente(sFileChiavi) = False Then bEliminaFileArc = True
    ReDim aKey(nQArchivi)
    Call LeggiChiaviDaFile(sFileChiavi,aKey)
    ' aggiorna o crea se non esistono gli archivi virtuali
    nArcCreati = 0
    Do While nArcCreati < nQArchivi
        nSalv = 0
        nTmpNumArc = nArcCreati + 1
        If nTmpNumArc=1 Then aKey(nTmpNumArc)="0"
        If aKey(nTmpNumArc) = "" Then
            ReDim aCol(0)
            Call GetColonnaCasuale(nClasseKey,aCol)
            Call MischiaColonna(aCol)
            sTmpCol = StringaNumeri(aCol)
            Do While AddItemColl(coll,sTmpCol,"k" & sTmpCol) = False
                Call GetColonnaCasuale(nClasseKey,aCol)
                Call MischiaColonna(aCol)
                sTmpCol = StringaNumeri(aCol)
            Loop
            aKey(nTmpNumArc) = sTmpCol
            bCalcRitMax = True
        Else
            bCalcRitMax = False
        End If
        ReDim aNumKey(0)
        Call SplitByChar("." & aKey(nTmpNumArc),".",aNumKey)
        sFileArc = GetFileArchivioVirt(sDirArchivi,nEstrIni,nClasseKey,nQArchivi,nTmpNumArc)
        If bEliminaFileArc Then EliminaFile(sFileArc)
        Call Messaggio("Archivio numero " & nTmpNumArc)
        If FileEsistente(sFileArc) Then
            If ApriFileBaseDati(sFileArc) Then
                nQEstrInArcV = QuantitaEstrazioniInFile(sFileArc)
            Else
                nQEstrInArcV = 0
            End If
        Else
            nQEstrInArcV = 0
        End If
        idEstrAV = nQEstrInArcV
        ' cicla dalla prima estrazione da aggiungere fino a quelle disponibili nell'archivio reale
        Call AvanzamentoElab(1,nQArchivi,nTmpNumArc)
        For idEstrAR =((nEstrIni - 1) + nQEstrInArcV) + 1 To nQEstrAR
            idEstrAV = idEstrAV + 1
            nPosKey =(idEstrAV Mod nClasseKey) + 1
            On Error Resume Next
            nn = Int(aNumKey(nPosKey))
            If IsNull (nn) Then nn=0
            Err.Clear
            ReDim aEstrV(11,5)
            For r = 1 To 11
                If Int(aEstrArcReale(idEstrAR,r,1)) > 0 Then
                    For e = 1 To 5
                        aEstrV(r,e) = Fuori90(Int(aEstrArcReale(idEstrAR,r,e)) + nn)
                    Next
                Else
                    For e = 1 To 5
                        aEstrV(r,e) = aEstrArcReale(idEstrAR,r,e)
                    Next
                End If
            Next
            ReDim aTmp(0)
            Call SplitByChar(aEstrArcReale(idEstrAR,0,0),"-",aTmp)
            If SalvaEstrazione(aEstrV,aTmp(0),aTmp(1),sFileArc) Then
                nSalv = nSalv + 1
                Call Messaggio("Archivio " & nTmpNumArc & " di " & nQArchivi & " colonne " & nSalv)
            End If
        Next
        If ScriptInterrotto Then Exit Do
        If bCalcRitMax Then
            If ApriFileBaseDati(sFileArc) Then
                Call Messaggio("Calcolo ritardo massimi per estratto su archivio numero " & nTmpNumArc)
                nRitMax = GetRitardoMaxEstrattoArchivio(0,0,1)
                nRitRelMax = GetRitRelMaxArchivio(1,EstrazioniArchivio,0,0)
                If(nRitMax >= nRitMaxMin And nRitMax <= nRitMaxMax) And(nRitRelMax >= nRitRelMaxMin And nRitRelMax <= nRitRelMaxMax) Then
                    nArcCreati = nArcCreati + 1
                Else
                    Call EliminaFile(sFileArc)
                    aKey(nTmpNumArc) = ""
                    Call ResetRitardoRel
                End If
            End If
        Else
            nArcCreati = nArcCreati + 1
        End If
    Loop
    Set coll = Nothing
    If ScriptInterrotto = False Then
        Call EliminaFile(sFileChiavi)
        For k = 1 To UBound(aKey)
            Call ScriviFile(sFileChiavi,aKey(k),False)
        Next
        Call CloseAllFileHandle
    End If
End Sub
Sub ScriviRitMaxPerArchivio(nClasseChiave,nQArchivi,sDirArcVirt,nEstrIni)
    Dim k
    Dim Inizio,Fine
    Dim sFileArc
    Dim nRetRitMax,nRetNum,nRetRuota
    Dim nRitRelMax
    ReDim av(5)
    av(1) = "Numero"
    av(2) = "Ruota"
    av(3) = "Ritardo max"
    av(4) = "Rit Rel max"
    av(5) = "Archivio num"
    Call InitTabella(av,vbYellow)
    For k = 1 To nQArchivi
        sFileArc = GetFileArchivioVirt(sDirArcVirt,nEstrIni,nClasseChiave,nQArchivi,k)
        Call Messaggio("Calcolo ritardi massimi per estratto su archivi ")
        If ApriFileBaseDati(sFileArc) Then
            nRetRitMax = GetRitardoMaxEstrattoArchivio(nRetNum,nRetRuota,1)
            nRitRelMax = GetRitRelMaxArchivio(1,EstrazioniArchivio,0,0)
            av(1) = nRetNum
            av(2) = NomeRuota(nRetRuota)
            av(3) = nRetRitMax
            av(4) = nRitRelMax
            av(5) = "Arc_" & FormattaStringa(k,"0000")
            Call AddRigaTabella(av)
        End If
        Call AvanzamentoElab(1,nQArchivi,k)
        If ScriptInterrotto Then Exit For
    Next
    Call CreaTabella(3)
End Sub

LuigiB · 22 Dicembre 2015

Guarda dal cel non riesco a vedere bene ..io non l ho ancora fatto pero so come lo vorrei fare....seplicemente creando come prima chiave una lunghetta di soli numeri 0....poi forse bisognera modificare solo il ciclo che crea gli archivi per la nuova lunghetta

i legend · 22 Dicembre 2015

P.s
Non ho calcolato il RitMax ovviamenete perchè è gia calcolato di default

LuigiB · 22 Dicembre 2015

i legend · 22 Dicembre 2015

Credo di aver fatto qualcosa di simile
I ????
A che si riferiscono?
Se è per il ritardo essendo il primo archivio è per forza in elenco .
A stasera

LuigiB · 22 Dicembre 2015

niente niente .. ho anche io i miei limiti non avevo capito che ti riferivi a quello che ci ha suggerito mirapep ... non nego che dentro di me ho pensato se legend è andato un'altra volta per la tangente lo strozzo ..(senso figurato)

... eehhe stavolta ho sbagliato io ...

LuigiB · 22 Dicembre 2015

ora prima di passare alla seconda parte dello script ci dedichiamo a una cosa piu semplice.
Ci vuole una funzione che mi converta il numero virtuale in numero reale prova a farla ,, decidi tu i parametri che servono.. fatta questa funzione passiamo alle routine ceh serviranno per analizzare un eventuale altro script .. ripeto che questa seconda parte è lo scopo finale di questo script , cioè analizzare un metodo presente in un qualsivoglia altro script sugli archivi virtuali creati da questo al fine di ottenere le convergenze per i numeri da giocare .. ora che il tutto funzioni a livello di gioco ho serissimi dubbi ma è evidente che non era quella ne la pretesa ne lo scopo ..

i legend · 22 Dicembre 2015

Ciao luigi dopo cena mi ci dedico

A dopo

Ho dimenticato di mettere un exit For su uno script
Sto sviluppando ke quaterna

Spero che dopo cena finisca.

LuigiB · 22 Dicembre 2015

quale miglior sistema per ingannare l'attesa che mettersi a studare su qella funzione

.. ehehh scherzo fai con comodo .. tanto per me se ne riparla domani .. sto invecchiando ...c'ho una stanchezza che mi sento tramortito .-)

i legend · 22 Dicembre 2015

allora buona notte

a domani

i legend · 23 Dicembre 2015

ciao in teoria riesco a beccare il valore della chiave
ma ho il dubbio se ho trovato il numero reale o quello di gioco.
il reale si sottrae quello di gioco si somma
Bho è tardi

Codice:

Option Explicit
Sub Main
    Dim idEstr,k,nPosKey,id,e,nn
    Dim nQestrAR,nClasseKey
    Dim aNumKey(5),aNumArcVirt(3)
    nClasseKey = UBound(aNumKey)
    aNumArcVirt(1) = 42
    aNumArcVirt(2) = 81
    aNumArcVirt(3) = 37
    aNumKey(1) = 2
    aNumKey(2) = 22
    aNumKey(3) = 54
    aNumKey(4) = 29
    aNumKey(5) = 3
    nQestrAR = 13
    id = - 1
    For idEstr =(EstrazioneFin - nQestrAR) To EstrazioneFin
        id = id + 1
        Scrivi Format2(id) & "  ",1,False
        nPosKey =(id Mod UBound(aNumKey) + 1)
        nn = aNumKey(nPosKey)
        Scrivi "nn=" & Format2(nn) & " ",False,False,,vbRed
        Scrivi "EstrReal   " & StringaEstratti(idEstr,BA_) & " - ",False,False,,vbBlue
        Scrivi "EstrVirt   ",False,False
        For e = 1 To 5
            Scrivi Format2(Fuori90(Estratto(idEstr,BA_,e) + nn)) & ".",False,False
        Next
        Scrivi
    Next
    Scrivi "StringaNumeriVirtuali  " & StringaNumeri(aNumArcVirt,,True)
    Scrivi "StringaTrasformata     " & TrasformaArrayNumVirToNumVer(nQestrAR,nClasseKey,aNumKey,aNumArcVirt,nn)
    Scrivi "ChiaveApplicata =      " & nn
End Sub
' ho inserito NN tra i parametri solo per mostrare il sommativo esatto
Function TrasformaArrayNumVirToNumVer(nQestrAR,nClasseKey,aNumKey,aNumArcVirt,NN)
    Dim nPosKey
    Dim k
    Dim sNumVer
    nPosKey =(nQestrAR Mod nClasseKey) + 1
    NN = Int(aNumKey(nPosKey))
    For k = 1 To UBound(aNumArcVirt)
        sNumVer = sNumVer & Format2(Fuori90(aNumArcVirt(k) - NN)) & "."
    Next
    sNumVer = RimuoviLastChr(sNumVer,".")
    TrasformaArrayNumVirToNumVer = sNumVer
End Function

Ciao

Legend - NUOVA MISSIONE

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

Super Member >PLATINUM<

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

Premium Member