HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Nächstkleineren Wert suchen

Nächstkleineren Wert suchen
24.09.2003 15:37:07
Martin
Hallo zusammen,

ich habe einfach ein Problem mit meinem VBA-Code und finde dafür einfach keine Lösung, sodass ich hoffe, dass Ihr mir helfen könnt.

Das Problem ist folgendes:

Ich gebe in die Zelle I9 in dem Tabellenblatt mit dem Namen Eingabemaske eine Zahl ein (z.B. 50500).
Mit Hilfe eines Makros soll in einem anderen Tabellenblatt (hier mit dem Namen Honorartafeln) in einer Tabelle der Wert gesucht werden, welcher der nächstkleinere ist.

Die Tabelle schaut so aus:
Spalte A Spalte B Spalte C

35.000,00 € 6.976,00 € 8.913,00 €
40.000,00 € 7.733,00 € 9.901,00 €
45.000,00 € 8.487,00 € 10.856,00 €
50.000,00 € 9.234,00 € 11.810,00 €
75.000,00 € 12.568,00 € 16.041,00 €
100.000,00 € 15.622,00 € 19.854,00 €
150.000,00 € 21.105,00 € 26.593,00 €

Da ich als Zahl nun 50500 eingab, müßte das Makro mir den Wert 50000 markieren.

Der bisherige Code schaut so aus:


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


Ich wäre Euch dankbar, wenn Ihr mir helfen könnt. Ich grübel wie verrückt, probierte mehrere Varianten aus, ich finde jedoch einfach keine Lösung.

Vielen Dank im voraus!

Martin

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

Betreff
Datum
Benutzer
AW: Nächstkleineren Wert suchen
24.09.2003 15:43:21
BerndE
Hi Martin,

ohne zu Testen...

Versuch mal

If Cells(I, 1) >= suche Then Cells(I-1, 1).Select

Gruß
Bernd

www.bernds.page.de.vu
AW: Nächstkleineren Wert suchen
24.09.2003 18:55:56
Martin
Hallo Bernd,

besten Dank für Deine Antwort.

Ich habe es ausprobiert, jedoch markiert das Makro nicht den nächsthöhere bzw. nächstniedrigere Zahl. Wenn ich Cells(I, 1) >= eingebe markiert das Makro den Wert 850000 statt 75000. Wenn ich <= eingebe, dann sucht er sich sogar den größten Wert...

Hast Du vielleicht noch eine andere Idee?

Beste Grüße

Martin
AW: Nächstkleineren Wert suchen
25.09.2003 07:52:50
WernerB.
Hallo Martin,

was hältst Du hiervon:

Option Explicit

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

Viel Erfolg wünscht
WernerB.

P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).
AW: Nächstkleineren Wert suchen
29.09.2003 13:02:44
Martin
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
AW: Nächstkleineren Wert suchen
25.09.2003 07:53:31
BerndE
Moin Martin,

Asche über mein Haupt... natürlich muss man die For-Next-Schleife verlassen, nachdem die If-Anweisung zum ersten Mal den Wert markiert hat.

Also:
If Cells(I, 1) >= suche Then
Cells(I-1, 1).Select
exit for
end if

Jetzt müsste es klappen...

Gruß
Bernd

www.bernds.page.de.vu

300 Forumthreads zu ähnlichen Themen

Meistgelesene Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Ihre Stimme zählt!