You are here:---Rispondi a: [RISOLTO] conoscere valori > di
Rispondi a: [RISOLTO] conoscere valori > di2019-04-07T17:47:34+02:00

Home Forum Domande su Formule e Funzioni [RISOLTO] conoscere valori > di Rispondi a: [RISOLTO] conoscere valori > di

sidsid
Moderatore
    Post totali: 718

    Ti posto questa soluzione con udf + function per ordinamento.

    Per evitare il carattere “grassetto” nella distinzione per il numero di presenze dell’estratto (come da te richiesto), nelle celle in cui vengono restituiti i valori finali inserisco il risultato in questo formato: x(y), dove x è il numero estratto, ed il valore tra parentesi è il numero di presenze dell’estratto.

    Ammettendo il valore minimo in C2 di Foglio2, e il valore max in D2 di foglio2

    In un modulo standard inserisci sia la udf che la function
    Questa la udf

    Public Function MAX_PRESENZE(ByVal RNG As Range, ByVal POSIZIONE As Integer, vMin As Integer, vMax As Integer) As String
    Dim vTab As Variant, mioArr() As Variant, key As Variant
    Dim j As Long, jj As Long, n As Long
    Dim bEsci As Boolean
    Dim dict As Object
    
    If RNG.Cells(1, 1).value = vbNullString Then
        MAX_PRESENZE = vbNullString
        Exit Function
    End If
    
    Set dict = CreateObject("Scripting.Dictionary")
    vTab = RNG
    For j = LBound(vTab, 1) To UBound(vTab, 1)
        For jj = LBound(vTab, 2) To UBound(vTab, 2)
            If vTab(j, jj) = vbNullString Then
                bEsci = True
                Exit For
            End If
            If dict.Exists(vTab(j, jj)) Then
                dict(vTab(j, jj)) = dict(vTab(j, jj)) + 1
            Else
                dict(vTab(j, jj)) = 1
            End If
        Next jj
    If bEsci Then Exit For
    Next j
    
    For Each key In dict
        If dict(key) >= vMin And dict(key) <= vMax Then
            n = n + 1
            ReDim Preserve mioArr(1 To 2, 1 To n)
        
            'Debug.Print n, key, dict(key)
            mioArr(1, n) = key
            mioArr(2, n) = dict(key)
        End If
    Next key
    
    mioArr = Application.Transpose(mioArr)
    
    mioArr = ORDINAMENTO(mioArr)
    Set dict = Nothing
    MAX_PRESENZE = mioArr(POSIZIONE, 1) & " (" & mioArr(POSIZIONE, 2) & ")"
    End Function

    Questa la function

    Function ORDINAMENTO(Elenco As Variant) As Variant
    
    Dim X As Long, Y As Long
    Dim AAA As Variant, BBB As Variant
        
    'ORDINO LA MATRICE per max presenza
    For X = LBound(Elenco) To UBound(Elenco) - 1
        For Y = X + 1 To UBound(Elenco)
            If Elenco(X, 2) < Elenco(Y, 2) Then
                AAA = Elenco(X, 1): BBB = Elenco(X, 2)
                Elenco(X, 1) = Elenco(Y, 1): Elenco(X, 2) = Elenco(Y, 2)
                Elenco(Y, 1) = AAA: Elenco(Y, 2) = BBB
            End If
        Next Y
    Next X
    'ORDINO LA MATRICE per estratto (doppia chiave di ordinamento)
    For X = LBound(Elenco) To UBound(Elenco) - 1
        For Y = X + 1 To UBound(Elenco)
            If Elenco(X, 1) < Elenco(Y, 1) And Elenco(X, 2) = Elenco(Y, 2) Then
                AAA = Elenco(X, 1): BBB = Elenco(X, 2)
                Elenco(X, 1) = Elenco(Y, 1): Elenco(X, 2) = Elenco(Y, 2)
                Elenco(Y, 1) = AAA: Elenco(Y, 2) = BBB
            End If
        Next Y
    Next X
    ORDINAMENTO = Elenco
    End Function

    in M15 di foglio2 inserisci la chiamata alla udf
    =SE.ERRORE(SE($D15="";"";MAX_PRESENZE(Foglio1!$E6:$I14;RIF.COLONNA(A$1);$C$2;$D$2));"")
    e trascini sia a destra sia in basso

    I numeri in riga vengono inseriti ordinati prima per il numero di uscite, poi dal più grande al più piccolo.

    Fa sapere, ciao

    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