Boa noite!!

Leia as regras do fórum, postar arquivo compactado.

Quanto a sua dúvida, se o problema for uma função matricial (com obrigação de Shift + Ctrl + Enter), então tente...

=SOMARPRODUTO(MÁXIMO((A2:A7=A9)*(B2:B7)))

Essa, é uma das maneiras.

Sub MaximoMinimoTotalMedia()
Plan1.Range("G4") = Application.Evaluate("=MAX(IF(G2=A2:A11,IF(G3=D2:D11,IF(G1=B2:B11,C2:C11))))")
Plan1.Range("G5") = Application.Evaluate("=AVERAGEIFS(C2:C11,A2:A11,G2,D2:D11,G3,B2:B11,G1)")
Plan1.Range("G6") = Application.Evaluate("=SUMIFS(C2:C11,A2:A11,G2,D2:D11,G3,B2:B11,G1)")
Plan1.Range("G7") = Application.Evaluate("=AVERAGEIFS(C2:C11,A2:A11,G2,D2:D11,G3,B2:B11,G1)")
End Sub

Boa noite!!
Outras versões...

UDF....

Public Function MaxIF(criteriaRange As Range, searchValue As Variant, calcRange As Range) 
     
    AciveCell.Formula = "=SumProduct(Max((criteriaRange = searchValue) * (calcRange)))" 
     
End Function 

Option Explicit 
 
 'These functions have been developed by Alan Forster on 27th September 2004.
 'After years of desire he has actually written them!
 'The functions use the same evaluation methods as the CountIf and SumIf functions
 
Public Function MinIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MinIf = varValue 
End Function 
 
Public Function MaxIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MaxIf = varValue 
End Function 
 
Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean 
    Dim bolAreas    As Boolean, _ 
    bolSize     As Boolean 
    bolAreas = (rng1.Areas.Count = 1) Or (rng2.Areas.Count = 1) 
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _ 
    (rng1.Columns.Count = rng2.Columns.Count) 
    RangesOK = bolAreas And bolSize 
End Function 

ola, eu colei tudo dentro da macro aparece a formula MaxIf so que nao consegue caucluar completa a formula e aperece este erro " #VALOR!"
vc pode me da uma dica, euz o seguinte
apertei alt+f11 pareceu visual basic ai colei e fui na x na janela e fexei, estou fazendo correto?

Boa noite!!

Tentou minha 1º postagem???

Como é uma Função Definida pelo Usuário, precisa colocar dentro de um módulo.

Vá ao excel, digite =e_o_nome_da_função.(No caso =MaxIf..)

Tente minha 1º postagem, seria simples!
Att

Bom, se entendi bem acho que seria isso:

Option Base 1
Function maximose(intval1 As Range, intval2 As Range, cond As String)
Application.Volatile
Dim wf As WorksheetFunction
Set wf = WorksheetFunction

Dim Matrix() As Variant
On Error GoTo fim
ReDim Matrix(intval1.Count, 1)
    For Each valor1 In intval1
    num = num + 1
        If intval2(num) = cond Then
        Matrix(num, 1) = valor1
        Else
        Matrix(num, 1) = 0
        End If
    Next
maximose = wf.Max(Matrix)

fim:
Debug.Print Err.Number & " " & Err.Description
End Function

ola esta funcionou, so que numeros inteiro, exemplo tiver formato moeda, data, etc nao funciona
teria como mudar?

Boa noite!!

Teste essa que vai gostar!

Sub Max()
    Dim test
    
    test = Evaluate("=MAX(IF(A1:A7=A9,B1:B7))")
    
    MsgBox test
End Sub

Ou.....

Sub Max()
    Dim test
    
    test = Evaluate("=MAX(IF(A1:A7=A9,B1:B7))")
    
    [B9] = test
End Sub

alexandrevba
esta aqui:

        Public Function MaxIF(criteriaRange As Range, searchValue As Variant, calcRange As Range) 
     
    AciveCell.Formula = "=SumProduct(Max((criteriaRange = searchValue) * (calcRange)))" 
     
End Function 
-------------------------------------------------------------------------                                
 e esta 

----------------------------------------------------------------------------

     Option Explicit 

'These functions have been developed by Alan Forster on 27th September 2004.
'After years of desire he has actually written them!
'The functions use the same evaluation methods as the CountIf and SumIf functions

Public Function MinIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MinIf = varValue 
End Function 

Public Function MaxIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MaxIf = varValue 
End Function 

Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean 
    Dim bolAreas    As Boolean, _ 
    bolSize     As Boolean 
    bolAreas = (rng1.Areas.Count = 1) Or (rng2.Areas.Count = 1) 
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _ 
    (rng1.Columns.Count = rng2.Columns.Count) 
    RangesOK = bolAreas And bolSize 
End Function 
____________________________________
tambem apareceu este erro
_____________#VALOR!_____________

o que poderia ser
estou colando dentro de um modulo inclusive novo sempre modulo1

Boa noite!!

Minha postagem anterior resolve seu problema!!!

Att

ola esta funcionou, so que numeros inteiro, exemplo tiver formato moeda, data, etc nao funciona
teria como mudar?

Walteison
Você se refere a função que criei ?

Dei uma enxugada no código e fiz uma adaptação para usar datas também:

Function maximose(intval1 As Range, intval2 As Range, cond As String)
Application.Volatile
Dim wf As WorksheetFunction
Set wf = WorksheetFunction

Dim Matrix() As Variant
On Error GoTo fim
ReDim Matrix(intval1.Count, 1)
    For num = 1 To intval1.Count
        If intval2(num) = cond Then
        Matrix(num, 1) = intval1(num) * 1
        Else
        Matrix(num, 1) = 0
        End If
    Next
maximose = wf.Max(Matrix)

fim:
Debug.Print Err.Number & " " & Err.Description
End Function

Boa noite!!

Obrigado, pelo retorno!! Assim que poder marque seu tópico como resolvido!!

Precisando já sabe onde nos encontrar.

Abraços e at+++

Obrigado, pelo retorno!! Assim que poder marque seu tópico como resolvido!!

Alexandrevba

Acho que ele ainda não deu um retorno sobre a duvida dele.