You are here:---Rispondi a: [RISOLTO] Riferimento quaterne
Rispondi a: [RISOLTO] Riferimento quaterne2018-05-19T16:16:21+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Riferimento quaterne Rispondi a: [RISOLTO] Riferimento quaterne

sidsid
Moderatore
    Post totali: 718

    L’archivio di riferimento è il foglio Archivio_T?

    Qel caso fosse quello, questo il codice da mettere in un modulo standard (la udf è unica)
    Col mio pc:
    10 righe, 10 cicli in 12 minuti

    Sub VERIFICA_TERNI()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim vArchivio As Variant, vTerni As Variant, vFinale() As Variant, vTerno As Variant, v As Variant
    Dim nRighe As Integer, nCicli As Integer, nColRif As Integer, n As Integer, nPartenza As Integer, nArrivo  As Integer
    Dim j As Long, jj As Long, nRigaRif As Long
    
    Dim t As Date
    
    Set ws1 = Sheets("Esiti")
    Set ws2 = Sheets("Archivio_T")
    vTerni = ws1.Range("O18:O117497")
    nRighe = ws1.Range("N3")
    nCicli = ws1.Range("O3")
    nColRif = 15 'colonna "O"
    nRigaRif = 18 'prima riga del range di destinazione
    t = Time
    
    ReDim vFinale(1 To UBound(vTerni), 1 To nCicli)
    
    nPartenza = ws1.Range("Q3")
    nArrivo = nPartenza + nRighe - 1
    
    'ciclo che spazzola I TERNI in "O"
    For j = LBound(vTerni) To UBound(vTerni)
          
        'questo loop viene eseguito per le volte della cella O3 (cicli)
        For n = 1 To nCicli
    
            'trasformo la stringa del terno in un array
            vTerno = Split(vTerni(j, 1), "_")
            
            'range del ciclo n in cui fare la ricerca del TERNO
            vArchivio = ws2.Range("C" & nPartenza & ":V" & nArrivo)
            
            'ciclo le righe del range
            For jj = LBound(vArchivio, 1) To UBound(vArchivio, 1)
                
                'riga jj del range ciclato
                v = Application.WorksheetFunction.Index(vArchivio, jj, 0)
                
                'passo IL TERNO ciclato e l'archivio di ricerca alla udf
                If VERIFICA(v, vTerno) Then
                    vFinale(j, n) = vFinale(j, n) + 1
                End If
            
            Next jj
            'incremento le variabili
            nPartenza = nArrivo + 1
            nArrivo = nArrivo + nRighe
            If vFinale(j, n) = vbNullString Then vFinale(j, n) = 0
        Next n
        'riporto le variabili al valore iniziale
        nPartenza = ws1.Range("Q3")
        nArrivo = nPartenza + nRighe - 1
    Next j
    'pulisco il range di destinazione
    ws1.Range(ws1.Cells(nRigaRif, nColRif + 1), ws1.Cells(117497, nColRif + 10)).ClearContents
    
    'scarico la matrice nel range di destinazione
    ws1.Range(ws1.Cells(nRigaRif, nColRif + 1), ws1.Cells(nRigaRif + UBound(vTerni) - 1, nColRif + nCicli)).Value = vFinale
    
    MsgBox Format(Time - t, "HH:MM:SS"), vbInformation, "CODICE ESEGUITO IN....."
    
    Set ws1 = Nothing
    Set ws2 = Nothing
    
    End Sub
    • Questa risposta è stata modificata 1 anno, 4 mesi fa da sid sid.

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi