Hallo mh,

dafür brauchst du die Funktion KGRÖSSTE anstelle von MAX. Probiers mal mit diesem Code:

Sub Filtern()

Set r = Range("A1:E6")
crit1 = "Gruppe2"
crit2 = "Name7"
 
Application.ScreenUpdating = False
 
If Not FilterIsActive(r) Then
  r.AutoFilter  'Filter ein
  fseton = True
End If

If r.Parent.AutoFilter.FilterMode = True Then
  r.AutoFilter
  r.AutoFilter
End If

r.AutoFilter Field:=1, Criteria1:=crit1
r.AutoFilter Field:=2, Criteria1:=crit2

imax = Application.Count(r.Columns(3).SpecialCells(xlCellTypeVisible))
For i = 1 To imax
 r.AutoFilter Field:=3
 r.AutoFilter Field:=4
 r.AutoFilter Field:=3, Criteria1:=CStr(CDate(Application.Large(r.Columns(3).SpecialCells(xlCellTypeVisible), i)))
 kmax = Application.Count(r.Columns(4).SpecialCells(xlCellTypeVisible))
 For k = 1 To kmax
   r.AutoFilter Field:=4
   r.AutoFilter Field:=4, Criteria1:=CStr(CDate(Application.Large(r.Columns(4).SpecialCells(xlCellTypeVisible), k)))
   If r.Columns(5).SpecialCells(xlCellTypeVisible).Areas.Count = 1 Then
      Wert = r.Columns(5).SpecialCells(xlCellTypeVisible).Areas(1).Cells(2).Value
   Else
      Wert = r.Columns(5).SpecialCells(xlCellTypeVisible).Areas(2).Cells(1).Value
   End If
   If Wert <> "" And Wert <> 0 And Wert <> "000.000.000" Then gefunden = True
   If gefunden = True Then Exit For
 Next k
 If gefunden = True Then Exit For
Next i

Application.ScreenUpdating = True

If gefunden = False Then MsgBox "Für die Kriterien " & crit1 & " und " & crit2 & " gibt es keinen gültigen Wert!", vbExclamation Else MsgBox "Wert: " & Wert, vbInformation

If fseton Then
r.AutoFilter 'Filter wieder aus
End If

End Sub
Function FilterIsActive(ByVal r As Range) As Boolean
On Error Resume Next
FilterIsActive = r.Parent.AutoFilter.Filters.Count > 0
End Function

Gruß Mr. K.