You are here:---Rispondi a: [RISOLTO] Matrice a più intervalli
Rispondi a: [RISOLTO] Matrice a più intervalli 2018-08-18T16:05:09+00:00

Home Forum Domande su Formule e Funzioni [RISOLTO] Matrice a più intervalli Rispondi a: [RISOLTO] Matrice a più intervalli

sidsid
Moderatore
    Post totali: 437

    Un ulteriore modifica per rendere flessibile la udf, cambiando il quarto parametro (3 per il terno, 4 per la quaterna, 5 per la cinquina)

    Function Ricer(ByVal Rn1 As Range, ByVal Rn2 As Range, ByVal Num As Range, ByVal Etr As Integer)
    Dim rg1 As Variant, rg2 As Variant, rng As Variant
    Dim x As Long, nArr As Long
    Dim nc As Integer, j As Integer, n As Integer, n1 As Integer, _
        n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer
    
    rg1 = Rn1
    rg2 = Rn2
    rng = Array(rg1, rg2)
    
    Select Case Etr
        Case 2: n1 = 0: n2 = 1: n3 = 3: n4 = 6: n5 = 10
        Case 3: n1 = 0: n2 = 0: n3 = 1: n4 = 4: n5 = 10
        Case 4: n1 = 0: n2 = 0: n3 = 0: n4 = 1: n5 = 5
        Case 5: n1 = 0: n2 = 0: n3 = 0: n4 = 0: n5 = 1
    End Select
    
    For nArr = LBound(rng) To UBound(rng)
        For x = LBound(rng(nArr)) To UBound(rng(nArr))
            n = 0
            For j = 1 To 5
                n = n + WorksheetFunction.CountIf(Num, rng(nArr)(x, j))
            Next j
            
            If n >= Etr Then
                nc = nc + Application.WorksheetFunction.Choose(n, n1, n2, n3, n4, n5)
            End If
        Next x
    Next nArr
    Ricer = nc
    End Function

    Ciao :bye:

    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