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
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