Jump to content
DanielaSilva

VBA

Recommended Posts

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 

Share this post


Link to post
Share on other sites
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.

Edited by zep

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.