X magia

[i legend]

ciao Magia
mi sembra che hai scritto una funzione per raccogliere i dati e suddividerli a secondo di quello che ti serve
se puo esserti utile ti scrivo una versione alternativa cosi puoi confrontarla
non so se è abbastanza veloce ,e se funziona correttamente ma
per favore se hai modo di verificarla dimmi che ne pensi.
P.S: non faccio da molto tempo listati
Ciao

Option Explicit
' verificare che lo script restituisca dati esatti
' sub per raccolta dati in una matrice in base al filtro richiesto
Sub Main
    Dim i,F,sRic,M,sum,IdE ' variabili contatori e stringhe
    Dim nClass:nClass = 30 ' classe della colonna casuale
    Dim PMin:PMin=4  ' estremo i deciso da utente =filtro
    Dim Pmax:Pmax=4   'estremo s deciso da utente = filtro
    Dim aVric:aVric = Array("Nessuna Selezione","Decina","Cadenza","Figura")' array filtri filtri
    Dim iDric:iDric = ScegliOpzioneMenu(aVric,1,"Selezione filtro") ' indice filtro
    If iDric = 0 Then Exit Sub ' se filtro errato  esce dalla sub
    Dim uB,lB ' vaiabili limiti array
    Select Case iDric:Case 1:uB = 0:lB = 8:Case 2:uB = 0:lB = 9:Case 3:    uB = 1:lB = 9:End Select ' stabilisco valore limite inferiore e superiore del filtr0
        ReDim aRic(lB,3)
        '--------------------------------------------
        ReDim aEstr(0)
        Call GetColonnaCasuale(nClass,aEstr)
        Scrivi StringaNumeri(aEstr,,True),,,RGB(240,240,240),,,,True
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' questo ciclo for è il blocco di raccolta
        For F = uB To lB 'ciclo gli elementi del  filtro
            sRic = "":M = 0:sum = 0 'azzero stringhe e somme per ogni elemento
            For i = 1 To UBound(aEstr)' ciclo l array dei numeri da filtrare
                ' in base al filtro raccolgo i dati
                Select Case iDric
                    ' calcolo i dati
                Case 1: If Decina(aEstr(i)) = F Then sRic = sRic & Format2(aEstr(i)) & ",":sum = sum + aEstr(i):M = M + 1
                Case 2: If Cadenza(aEstr(i)) = F Then sRic = sRic & Format2(aEstr(i)) & ",":sum = sum + aEstr(i):M = M + 1
                Case 3: If Figura(aEstr(i)) = F Then sRic = sRic & Format2(aEstr(i)) & ",":sum = sum + aEstr(i):M = M + 1
                End Select
            Next
            'raccolco i Dati nell Array
            aRic(F,1) = RimuoviLastChr(sRic,",") ' stringa numeri
            aRic(F,2) = Format2(Fuori90(sum)) ' somma con fuori 90
            aRic(F,3) = Format2(M)
        Next
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'codice  output per verifica raccolta
        Scrivi
        Scrivi "|RICERCA        |N.E |SUM |" & FormatSpace("ESTRATTI",21) & "|",,,RGB(255,128,192),,,,True
        For i = uB To lB
            ' filtro per utilizzo dati utili
            If Int(aRic(i,3)) >= PMin And Int(aRic(i,3)) <= Pmax Then
                Scrivi "|" & FormatSpace(aVric(iDric),10) & ":" & Format2(i) & "  |" & aRic(i,3) & "  |" & aRic(i,2) & "  |" & FormatSpace(aRic(i,1),21) & "|",,,RGB(255,232,243)
            Else
                Scrivi "|" & FormatSpace(aVric(iDric),10) & ":" & Format2(i) & "  |" & aRic(i,3) & "  |" & aRic(i,2) & "  |Nessun Caso Rilevato |",,,RGB(155,132,143),vbWhite
            End If
        Next
End Sub

ciao...

 

[i legend]

ciao Magia
grazie mille per la considerazione, e, visto che ci conosciamo virtualmente da tempo , mi farebbe piacere se mi dessi del tu .
spero di esserti stato utile
P.s:
di ad amaretto che non è niente male come scripter