Function BereichKleinste(BrKl As Range, BrSu As Range) As Long
    Application.Volatile
    Dim Zelle As Range
    Dim Kl1 As Long, Kl2 As Long, Rk1 As Long, Rk2 As Long
    Kl1 = Rows.Count
    Kl2 = Rows.Count
    For Each Zelle In BrKl
        If Zelle.Value < Kl1 Or Zelle.Value = Kl1 Then
            Kl2 = Kl1
            Rk2 = Rk1
            Kl1 = Zelle.Value
            Rk1 = Zelle.Row
        End If
    Next Zelle
    For Each Zelle In BrSu
        If Zelle.Row = Rk1 And Zelle.Value < Kl1 Or Zelle.Row = Rk2 And Zelle.Value < Kl1 Then
            Kl1 = Zelle.Value
        End If
    Next Zelle
    BereichKleinste = Kl1
End Function  

Option Explicit

Function BereichKleinste(BrKl As Range, BrSu As Range) As Long
    Application.Volatile
    Dim Zelle As Range
    Dim IndexB As Long, SuchZelle As Long, Puffer As Long
    Dim KlWert() As Long
    Dim KlPos() As Long
    IndexB = 1
    Puffer = Rows.Count
    For Each Zelle In BrKl
        If Zelle.Value < Puffer Then
            Puffer = Zelle.Value
        End If
    Next Zelle
    For Each Zelle In BrKl
        If Zelle.Value = Puffer Then
            ReDim Preserve KlWert(1 To IndexB)
            ReDim Preserve KlPos(1 To IndexB)
            KlWert(IndexB) = Zelle.Value
            KlPos(IndexB) = Zelle.Row
            IndexB = IndexB + 1
        End If
    Next Zelle
    Puffer = Rows.Count
    For Each Zelle In BrSu
        For SuchZelle = 1 To IndexB - 1
            If Zelle.Row = KlPos(SuchZelle) And Zelle.Value < Puffer Then
                Puffer = Zelle.Value
            End If
        Next SuchZelle
    Next Zelle
    BereichKleinste = Puffer
End Function