Wenn Suchdatum innerhalb Zeitraum, dann

Sub SearchDate() Dim rngFind As Range, rngFindc As Range, rngRows As Range Dim sFind As String, sFindc As String, sSearch As Date 'Dim startDat As Date, endDat As Date On Error Resume Next sSearch = InputBox("Suchdatum:", , Date) Set rngFind = Columns.Item("B:C").Find(sSearch) If rngRows Is Nothing Then Set rngRows = rngFind End If If Not rngFind Is Nothing Then 'Or sSearch

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Uwe und alle anderen VBA-Experten,
ich habe mal eine abgespeckte Musterdatei ( https://www.herber.de/bbs/user/138558.xlsm
) hochgeladen aus der hervorgehen sollte was mein Anliegen ist. Nehmen wir einfach an es handelt sich bei der Tabelle um Gültigkeiten von Fahrkarten. Eine Fahrkarte ist immer mindestens an einem Tag gültig, nämlich an dem Datum welches in Spalte B steht. Manche Fahrkarten sind aber über einen Zeitraum gültig, nämlich dann, wenn in Spalte C ein späteres Datum steht. Dann ist also ein Gültigkeitszeitraum definiert.
Der Code markiert mir bereits erfolgreich alle Zeilen, wenn ich ein vorhandenes Datum in der Inputsuchfeld eingebe. (Standardmäßig steht im Input das aktuelle Datum, spielt aber keine Rolle). Wenn ich jetzt ein Datum eingebe, welches innerhalb eines Zeitraums liegt, soll(en) die Zeile(n) auch markiert werden - und das funktioniert noch nicht, weil ich nicht weiß, wo ich da ansetzen muss. Müsste sowas sein wie: Wenn Datum in Spalte C, dann Zeitraum, dann prüfen, ob Suchdatum zwischen Start- und Enddatum liegt, bzw größer gleich Datum in Spalte B und kleiner gleich Datum in Spalte C ist.
Konkretes Beispiel: Suche nach dem 15.02.2020. Markiert wird korrekt die Zeile 24 (Person 21). ABER: es fehlt die Markierung der Zeile 32 (Person 29). Denn der 15.02.2020 liegt innerhalb des Zeitraums zwischen 08.02.2020 und 16.02.2020 und soll auch markiert werden. Bin dankbar für jede Hilfe. Den bestehenden vba-Code habe ich zu Anfang gepostet.

Sub SearchDate() Dim sSearch As Variant Dim LR As Integer, i As Integer, Z1 As Integer, Sp As Integer, RNG As Range Dim Treffer As Integer Z1 = 4 'Werte ab dieser Zeile Sp = 2 'Spalte mit Datum sSearch = InputBox("Suchdatum:", , Date) If IsDate(sSearch) Then LR = Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte Set RNG = Cells(Z1, 1).Resize(LR - Z1 + 1, 5) 'Reset RNG.Interior.Pattern = xlNone For i = Z1 To LR 'entweder nur genau der Tag, oder zwischen den beiden Tagen If (Cells(i, Sp) = sSearch And Cells(i, Sp).Offset(0, 1) = "") _ Or (Cells(i, Sp) = sSearch) Then 'gelb färben With Intersect(RNG, Rows(i)).Interior .Pattern = xlSolid .Color = 65535 End With Treffer = Treffer + 1 'zählen End If Next If Treffer >0 Then MsgBox "Fertig. Treffer= " & Treffer Else MsgBox "Kein Eintrag mit diesem Suchdatum!" End If Else MsgBox "Ungültige Eingabe!" End If End Sub

Hallo Uwe,
letztlich sollen alle Treffer in einem Nachbarsheet landen. Ich habe dich so verstanden, dass ich an der ersten Zeile deines "With intersect-Blocks" ansetzen müsste, um zeilenweise (Treffer für Treffer) in ein Nachbarheet zu kopieren. (Intersect beinhaltet mindestens zwei oder mehr Ranges, kannte ich vorher noch nicht).
Kurzum: Es raucht, ich komme nicht weiter und habe Schrott produziert. Folgender Code ist ein Mix aus meinem Gefrickel und deiner If-Abfrage. Das führt zu nichts und ich poste den nur, damit du eine Vorstellung hast, was ich u.a. mit enbloque meinte. Das funktioniert allerdings nur ungenügend. Ich möchte gerne deinen sauberen Code benutzen, weiß aber nicht, wie ich den sinnvoll ergänzen muss, damit selektierte Treffer sowohl im Sheet Kartenliste als auch im Nachbarsheet Treffer erscheinen. Darf ich dich nochmals um Hilfe bitten?

Sub SearchDate()
Dim i As Integer    'Zählvariable
Dim sSearch As String 'Suchdatum (eigentlich date ?!)
Dim sRes As Range   'Ergebniszeile
Dim lastRow As Long 'Suchspaltenende
Dim Sp As Integer
'On Error Resume Next
Sp = 2
Worksheets(2).Rows("2:65536").ClearContents
sSearch = InputBox("Suchdatum:", , Date)
If sSearch = "" Then Exit Sub
With Worksheets("Kartenliste")
lastRow = Cells(Rows.Count, Sp).End(xlUp).Row    'Suche in Spalte B bis letzte gefüllte Zeile
For i = 4 To lastRow   'Ab Zeile 4 unterhalb Spaltenüberschrift anfangen zu suchen
'If .Cells(i, 2) = sSearch Then    'bei Treffer nächste Zeile
If (Cells(i, Sp) = sSearch And Cells(i, Sp).Offset(0, 1) = "") _
Or (Cells(i, Sp) = sSearch) Then
If sRes Is Nothing Then         '?
Set sRes = Cells.Rows(i)    '?
Else
Set sRes = Union(sRes, Cells.Rows(i))   'Zeile merken?
End If
End If
Next i
sRes.Select    'alle gefundenen Ergebniszeilen auswählen
End With
Selection.Copy
Sheets("Treffer").Select
Range("A2").Select
ActiveSheet.Paste
Columns("A:E").EntireColumn.AutoFit
Application.CutCopyMode = False
End Sub
'Else
'MsgBox "Kein Suchdatum gefunden"
'Exit Sub

Beliebteste Forumthreads (12 Monate)

Wenn Suchdatum innerhalb Zeitraum, dann

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Suchdatum innerhalb Zeitraum, dann

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

332 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread