Suche rückwärts nach Wert wenn Bedingung erfuellt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
da es beim Suchen von Datumswerten immer Probleme gibt mit der Find Funktion, hier ein e Variante mit der Match Funktion.
Es wird das aktuelle Datum im Bereich gesucht,
wird dieses nicht gefunden, wird das nächst kleinere gesucht.
Getestet unter xl2007

Option Explicit

Sub SuchDatum()
Dim LRow
Dim SuchBereich As Range
Set SuchBereich = Tabelle1.Range("A1:A100")

With Application
    'aktuelles Datum suchen und die Zeile aus der Matrix zurückgeben 
    LRow = Application.Match(CLng(Date), SuchBereich, 0)

    If IsNumeric(LRow) Then 'aktuelles Datum gefunden? 
      MsgBox "Datum gefunden in: " & Chr(13) & SuchBereich(LRow).Address(0, 0)
    Else
 
    'nächst kleinere Datum suchen und die Zeile aus der Matrix zurückgeben 
    LRow = _
    .Match(.Small(SuchBereich, .CountIf(SuchBereich, "<=" & CLng(Date))), SuchBereich, 0)
  
    If IsNumeric(LRow) Then
      MsgBox "nächst kleinere Datum gefunden in: " & Chr(13) & _
              vbTab & SuchBereich(LRow).Address(0, 0) & Chr(13) & _
              "das Datum lautet: " & Chr(13) & _
              vbTab & SuchBereich(LRow)
              
    Else 'kein Datum gefunden 
      MsgBox "Es wurde kein Datum gefunden!"
    End If

End If

End With

End Sub

Gruß Tino

Option Explicit Sub SuchDatum() Dim LRow Dim SuchBereich As Range Set SuchBereich = Tabelle1.Range("A1:A100") With Application LRow = _ .Match(.Small(SuchBereich, .CountIf(SuchBereich, "<=" & CLng(Date))), SuchBereich, 0) If IsNumeric(LRow) Then 'Datum gefunden If SuchBereich(LRow) < Date Then 'Datum ist kleiner? MsgBox "nächst kleinere Datum gefunden in: " & Chr(13) & _ vbTab & SuchBereich(LRow).Address(0, 0) & Chr(13) & _ "das Datum lautet: " & Chr(13) & _ vbTab & SuchBereich(LRow) Else 'Datum ist aktuell MsgBox "Datum gefunden in: " & Chr(13) & SuchBereich(LRow).Address(0, 0) End If Else 'kein Datum gefunden MsgBox "Es wurde kein Datum gefunden!" End If End With End Sub

Sub t() Dim rSuche As Range, rFinde As Range, SuchDatum As Date Set rFinde = Range("A:A") SuchDatum = "10.01.2008" Do Set rSuche = rFinde.Find(what:=SuchDatum, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:= _ xlPrevious) If Not rSuche Is Nothing Then rSuche.Select Exit Sub Else SuchDatum = SuchDatum - 1 End If Loop Until SuchDatum = "01.01.2000" End Sub

Beliebteste Forumthreads (12 Monate)

Suche rückwärts nach Wert wenn Bedingung erfuellt

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suche rückwärts nach Wert wenn Bedingung erfuellt

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread