Herbers Excel-Forum - das Archiv
Nächstkleineren Wert suchen
- Nächstkleineren Wert suchen von Martin vom 24.09.2003 15:37:07
- AW: Nächstkleineren Wert suchen - von BerndE am 24.09.2003 15:43:21
- AW: Nächstkleineren Wert suchen - von Martin am 24.09.2003 18:55:56
- AW: Nächstkleineren Wert suchen - von WernerB. am 25.09.2003 07:52:50
- AW: Nächstkleineren Wert suchen - von Martin am 29.09.2003 13:02:44
- AW: Nächstkleineren Wert suchen - von Martin am 29.09.2003 13:02:44
- AW: Nächstkleineren Wert suchen - von BerndE am 25.09.2003 07:53:31
- AW: Nächstkleineren Wert suchen - von WernerB. am 25.09.2003 07:52:50
- AW: Nächstkleineren Wert suchen - von Martin am 24.09.2003 18:55:56
- AW: Nächstkleineren Wert suchen - von BerndE am 24.09.2003 15:43:21
 |
Betrifft: Nächstkleineren Wert suchen
von: Martin
Geschrieben am: 24.09.2003 15:37:07
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
 |
Betrifft: AW: Nächstkleineren Wert suchen
von: BerndE
Geschrieben am: 24.09.2003 15:43:21
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
|
Betrifft: AW: Nächstkleineren Wert suchen
von: Martin
Geschrieben am: 24.09.2003 18:55:56
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
|
Betrifft: AW: Nächstkleineren Wert suchen
von: WernerB.
Geschrieben am: 25.09.2003 07:52:50
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).
|
Betrifft: AW: Nächstkleineren Wert suchen
von: Martin
Geschrieben am: 29.09.2003 13:02:44
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
|
Betrifft: AW: Nächstkleineren Wert suchen
von: BerndE
Geschrieben am: 25.09.2003 07:53:31
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
| |