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 BerndE am 25.09.2003 07:53:31

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

Beiträge aus den Excel-Beispielen zum Thema " Nächstkleineren Wert suchen"