Nächstkleineren Wert suchen

Sub Markieren() Dim suche As String, I As Long, Letzte As Long ', Obergrenze As Integer Sheets("Kopie Honorartafel").Select If [A110] = "" Then Letzte = [A110].End(xlUp).Row Else Letzte = 110 End If suche = Sheets("Eingabemaske").Range("I9").Value On Error Resume Next For I = 81 To Letzte If Cells(I, 1) = suche Then Cells(I, 1).Select Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Markieren() Dim suche As Double Dim i As Long, laR As Long Sheets("Honorartafeln").Select If Range("A110").Value = "" Then laR = Range("A110").End(xlUp).Row Else laR = 110 End If suche = Sheets("Eingabemaske").Range("I9").Value For i = laR To 81 Step -1 If Cells(i, 1).Value < suche Then Cells(i, 1).Select Exit For End If Next i End Sub

Hallo Bernd und WernerB,

vielen Dank für Eure Antwort. Jetzt funktioniert die Prozedur einwandfrei. Um den nächstkleineren Wert zu kopieren und an anderer Stelle einzufügen, sieht die Prozedur jetzt folgendermaßen aus:


Sub Kleiner()
'Mit diesem Makro wird in der Tabelle "Honorartafel" der 'nächstniedrigere' Wert markiert, dann kopiert
'und in der angegebenen Zelladresse eingefügt.
Dim suche As Double
Dim i As Long, Letzte As Long
Sheets("Honorartafel").Select
If Range("A110").Value = "" Then
Letzte = Range("A110").End(xlUp).Row
Else
Letzte = 110
End If
suche = Sheets("Eingabemaske").Range("I9").Value
On Error Resume Next
For i = Letzte To 81 Step -1
If Cells(i, 1) < suche Then
Cells(i, 1).Select
'Wert in der markierten Zelle kopieren und in Zieladresse einfügen
Selection.Copy
Range("I94").Select
ActiveSheet.Paste
Exit For
End If
Next i
End Sub

Um den nächstgrößeren Wert zu kopieren und an anderer Stelle wieder einzufügen, gilt es die For-Schleife im Makro wie folgt abzuändern:

For i = 81 To Letzte Step 1
If Cells(i, 1) > suche Then
Cells(i, 1).Select
'Wert in der markierten Zelle kopieren und in Zieladdresse einfügen
Selection.Copy
Range("I94").Select
ActiveSheet.Paste
Exit For
End If
Next i

Also, Bernd und WernerB: Vielen Dank noch einmal für Eure Hilfe!! Jetzt bleibt mir das mühselige Umschreiben dieses Codes mit dem If-Then-Else-Befehl erspart!!

Nochmals vielen Dank und beste Grüße

Martin

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nächstkleineren Wert suchen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread