Suchen/Finden eines Wertes

Private Sub zusammen_Click()



'Letze beschriebene Zeile ermitteln

Dim loLetzte As Long

loLetzte = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Row

loLetzte = loLetzte - 1

'MsgBox "Die Tabelle endet in Zeile " & loLetzte





'nächstliegende Zahl finden

    Dim Numbers

    Dim item

    Dim closestValue As Double

    Dim diff As Double

    Dim minDiff As Double

    minDiff = 0.5

    

    Numbers = Range("F5:F" & loLetzte)

        

    For Each item In Numbers

        diff = Abs(item - Range("I17"))

        If diff  minDiff Then

            minDiff = diff

            closestValue = item

        End If

    Next item

    'MsgBox "The closest value: " & closestValue





'erste Zeile in der der Suchbegriff enthalten ist

Dim Rng_1 As Range

Set Rng_1 = ActiveSheet.Range("F5:F" & loLetzte).Find(what:=closestValue)

If Rng_1 Is Nothing Then

MsgBox "Nichts gefunden"

Exit Sub

End If

MsgBox "Zeile: " & Rng_1.Row & "; Adresse: " & Rng_1.Address



'ermittelte Zeile in Tabelle schreiben

Range("J6").value = Rng_1.Row

End Sub