VBA

[DanielaSilva]

Boa noite podem ajudar-me a criar uma função em VBA que me permita fazer média dos n maiores valores de uma lista ? Por exemplo se tiver a lista (2, 5, 7, 2, 3, 4) e n=3 é feita a média dos 3 maiores valores, 4, 5, 7 

[zep]

        Dim inteiros As New List(Of Integer) From {2, 5, 6, 2, 3, 4, 2, 10, 9, 11, 11, 4, 8, 9, 2, 5, 6, 2}
        Dim n(4) As Integer ' Dimensão é 5. Exemplo com 5 maiores valores
        For i As Integer = 0 To inteiros.Count - 1
            Dim rep As Boolean = False
            For j As Integer = 0 To n.Count - 1 ' Verificar Repetições
                If n(j) = inteiros(i) Then
                    rep = True
                    Exit For
                End If
            Next

            If rep = False Then
                If n(n.Count - 1) = Nothing Then
                    For k As Integer = 0 To n.Count - 1 ' Preencher Array
                        If n(k) = Nothing Then
                            n(k) = inteiros(i)
                            Exit For
                        End If
                    Next
                Else
                    Dim n_array As Integer = 0
                    Dim menorvalor As Integer = n(0)
                    For l As Integer = 1 To n.Count - 1 ' Encontrar Menor Valor
                        If n(l) < menorvalor Then
                            menorvalor = n(l)
                            n_array = l
                        End If
                    Next

                    If n(n_array) < inteiros(i) Then ' Substituir Menor Valor
                        n(n_array) = inteiros(i)
                    End If
                End If
            End If
        Next

        For m As Integer = 0 To n.Count - 1
            MsgBox("Valores Máximos: " & n(m))
        Next

Ainda mais simples e com o calculo da média:

        Dim inteiros As New List(Of Integer) From {2, 5, 6, 2, 3, 4, 2, 10, 9, 11, 11, 4, 8, 9, 2, 5, 6, 2}
        Dim n(4) As Integer ' Dimensão é 5. Exemplo com 5 maiores valores
        For i As Integer = 0 To n.Count - 1
            n(i) = inteiros.Max()
            For j As Integer = 0 To inteiros.Count - 1 ' Rescrever Array Inteiros
                If inteiros(j) = n(i) Then
                    inteiros(j) = 0 ' Mínimo Valor é 0
                End If
            Next
        Next

        For k As Integer = 0 To n.Count - 1
            MsgBox("Valores Máximos: " & n(k))
        Next

        Dim sum As Integer
        For Each l As Integer In n
            sum += l
        Next

        MsgBox("Valor Médio: " & sum / n.Count)

De forma a contabilizar todos os máximos em que a sequência seria (11,11,10,9,9), terias de forçar o encerramento do ciclo for j.

Assim terias a média dos 5 máximos mesmo sendo repetidos. 

            For j As Integer = 0 To inteiros.Count - 1 ' Rescrever Array Inteiros
                If inteiros(j) = n(i) Then
                    inteiros(j) = 0 ' Mínimo Valor é 0
                    Exit For
                End If
            Next

Desculpa, agora em VBA:

    Dim inteiros As Variant
    inteiros = Array(2, 5, 6, 2, 3, 4, 2, 10, 9, 11, 11, 4, 8, 9, 2, 5, 6, 2)
    Dim n(4) As Integer ' Dimensão é 5. Exemplo com 5 maiores valores
    Dim i As Integer
    For i = 0 To UBound(n)
        n(i) = WorksheetFunction.Max(inteiros)
        Dim j As Integer
        For j = LBound(inteiros) To UBound(inteiros) ' Rescrever Array Inteiros
            If inteiros(j) = n(i) Then
                inteiros(j) = 0 ' Mínimo Valor é 0
                Exit For
            End If
        Next
    Next
    
    Dim sum As Integer
    sum = 0
    Dim k As Variant
    For Each k In n
        sum = k + sum
    Next

    ActiveCell.Value = sum / (UBound(n) + 1)

Nota: Neste caso a sequência dos máximos é (11,11,10,9,9) - todos os máximos. De forma a ter uma sequência sem repetições (11,10,9,8,6) - todos os máximos de um só tipo - basta apagar Exit For no ciclo For j.

[zep]

Obtendo os valores a partir do Excel:

Dim myCells As Range
    Dim inteiros() As Integer
    ReDim inteiro(0)
    Dim count As Integer
    count = 0
    For Each myCells In Selection ' Criar Array Inteiros
        If IsEmpty(myCells.Value) = False Then
            ReDim Preserve inteiros(count)
            inteiros(count) = myCells.Value
            count = count + 1
        End If
    Next
    
    If (Not Not inteiros) <> 0 Then
        Dim n(4) As Integer ' Dimensão é 5. Exemplo com 5 maiores valores
        Dim i As Integer
        For i = 0 To UBound(n)
            n(i) = WorksheetFunction.Max(inteiros)
            Dim j As Integer
            For j = LBound(inteiros) To UBound(inteiros) ' Rescrever Array Inteiros
                If inteiros(j) = n(i) Then
                    inteiros(j) = 0 ' Mínimo Valor é 0
                    Exit For ' Por exemplo: a sequencia é (11,11,10,9,9). De forma a ter uma sequencia (11,10,9,8,6) basta apagar esta linha
                End If
            Next
        Next
        
        Dim sum As Integer
        sum = 0
        Dim l As Variant
        For Each l In n
            sum = l + sum
        Next

        MsgBox "A Média é: " & sum / (UBound(n) + 1)
    End If

[Renato MDSP]

Ola Daniela. Tenta isso. Qualquer dúvida estou a disposição.

Function Calcula_Media_Criterio(numeros As Variant, qtd_nr_a_calcular As Integer) As Integer
    ReDim maiores_numeros(1 To qtd_nr_a_calcular)
    For i = 1 To qtd_nr_a_calcular
        maiores_numeros(i) = Application.Large(numeros, i)
    Next
       Calcula_Media_Criterio = Application.Average(maiores_numeros)
End Function
Sub Calcula_Media()
    numeros = Array(2, 50, 80, 70, 25, 22, 23, 200, 10, 15, 22, 45, 2, 5, 7, 10, 5, 7, 2, 3, 4, 6)
    media = Calcula_Media_Criterio(numeros, 8)
    MsgBox "A média é:" & vbLf + vbLf & media
End Sub