Hallo,

es hat etwas länger gedauert, als ich vermutet hätte.

Der VBA-Code gibt den DBLMin und DBLMax-Wert in der Konsole aus:

Sub grossklein_Version2()
    Dim dblMin As Double
    Dim dblMax As Double
    Dim shWert1 As Worksheet
    Dim shWert2 As Worksheet
    Set shWert1 = ThisWorkbook.Sheets(1)
    Set shWert2 = ThisWorkbook.Sheets(2)
    Dim rngRow As Range
    Dim rng As Range, rngFound As Range
    Dim rngATemp As Range
    Dim rngFind As Range
    Dim iRow As Integer
    For Each rngRow In shWert1.UsedRange.Rows
        Set rngATemp = rngRow.Cells(Columnindex:=6)
        If IsNumeric(rngATemp.Value) Then
            If shWert2.AutoFilterMode = False Then
                shWert2.UsedRange.Rows(1).AutoFilter
            End If
            Set rngFind = shWert2.UsedRange.Columns(2)
            If rngFind.Worksheet.AutoFilterMode = False Then
                rngFind.Worksheet.ShowAllData
            End If
            rngFind.AutoFilter Field:=2, Criteria1:=Replace(CDbl(rngATemp.Value), ",", ".")
            If rngFind.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                dblMax = WorksheetFunction.Min(rngFind.Columns(1).SpecialCells(xlCellTypeVisible))
                dblMin = dblMax
                Debug.Print "Wert gefunden: "; dblMax
            ElseIf rngFound Is Nothing Then
                ' Nächste Werte finden
                dblMax = 0
                dblMin = 0
                rngFind.Worksheet.ShowAllData
                rngFind.AutoFilter Field:=2, Criteria1:=">" & Replace(CDbl(rngATemp.Value), ",", ".")
                dblMax = WorksheetFunction.Min(rngFind.Columns(1).SpecialCells(xlCellTypeVisible))
                rngFind.Worksheet.ShowAllData
                rngFind.AutoFilter Field:=2, Criteria1:="<" & Replace(CDbl(rngATemp.Value), ",", ".")
                dblMin = WorksheetFunction.Max(rngFind.Columns(1).SpecialCells(xlCellTypeVisible))
                
                Debug.Print "Näherungswerte Gefunden: "; rngATemp.Value, dblMin, dblMax
            End If
        End If
    Next
End Sub

Anstatt jede Zelle durchlaufen, wird einfach ein AutoFilter gesetzt und das Ergebnis der Funktion Max bzw. Min übergeben.

LG, BigBen