Kopieren von Zeilen zwischen zwei Datumsangaben

Forumthread: Kopieren von Zeilen zwischen zwei Datumsangaben

29.09.2017 11:53:13

Zeilen

Hallo liebe Excelianer,
ich möchte gern in einer Tabelle (Archiv) nach Zeilen suchen und diese dann auf einem anderen Tabellenblatt (Auswahl) ausgeben (also kopieren und auf dem anderen Tabellenblatt einfügen). Jedoch sollten alle Zeile die zwischen zwei Datum's stehen kopiert werden.
Ich habe es auch schon etwas versucht, habe keine Idee wie ich weiter komme. Hier der Schnipsel mit dem ich begonnen habe, habe aber noch keine Idee wie ich das mit dem kopieren umsetze.

Private Sub nach_Datum_suchen()
Dim lngZeile As Long, lngZiel As Long
Dim varAntwort
Dim datStart As Date, datEnde As Date
varAntwort = InputBox("Bitte Anfangsdatum des Zeitraums eingeben:", "Startdatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datStart = CDate(varAntwort)
Else
MsgBox "Eingegebenens Startdatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Startdatum fehlt!"
Exit Sub
End If
varAntwort = InputBox("Bitte Endedatum des Zeitraums eingeben:", "Endedatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datEnde = CDate(varAntwort)
Else
MsgBox "Eingegebenens Endedatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Endedatum fehlt!"
Exit Sub
End If
End Sub

Hier meine Beispieldatei:
https://www.herber.de/bbs/user/116627.xlsm
Ich würde mich sehr über Hilfe freuen.
Beste Grüße
Oliver

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Kopieren von Zeilen zwischen zwei Datumsangaben

29.09.2017 14:07:51

Zeilen
AW: Kopieren von Zeilen zwischen zwei Datumsangaben

29.09.2017 16:24:12

Zeilen
Danke für Kritik

29.09.2017 17:05:18

Peter(silie)

AW: Kopieren von Zeilen zwischen zwei Datumsangaben

29.09.2017 14:07:51

Zeilen

Hallo,
hier deine Datei mit neuem Code: https://www.herber.de/bbs/user/116630.xlsm
Hier nur Code:

Option Explicit
Private First_Match, Second_Match As Date
Public Sub ExecuteMatching()
Dim ArchivTable As Worksheet
Dim start_, end_ As Long
Dim lRow As Long
Dim rng As Range
'//Get Userinput
DefineMatches
'//If something went wrong, exit here
If IsNull(First_Match) Or IsNull(Second_Match) Then Exit Sub
'//Define Range we need it later!
Set ArchivTable = ThisWorkbook.Sheets("Archiv")
With ArchivTable
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(1, 1), .Cells(lRow, 1))
End With
'//Position of first Input
'//Position of second Input
start_ = MatchThis(First_Match, ArchivTable, rng)
end_ = MatchThis(Second_Match, ArchivTable, rng)
'//If the second input couldnt be found, then just copy nothing
'//if you want to copy everything to the end instead just do: If end_ = 0 Then end_ = lRow
If start_ = 0 Or end_ = 0 Then Exit Sub
'//Define new range with our start and end points
With ArchivTable
Set rng = .Range(.Cells(start_, 1), .Cells(end_, 4))
End With
'//Export this range to a other sheet
ExportToSheet "Auswahl", rng
MsgBox "Done!"
Set rng = Nothing
Set ArchivTable = Nothing
End Sub
'//Get User Input
Private Sub DefineMatches()
Dim datStart As Date, datEnde As Date
Dim varAntwort As Variant
varAntwort = InputBox("Bitte Anfangsdatum des Zeitraums eingeben:", "Startdatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datStart = CDate(varAntwort)
First_Match = datStart
Else
MsgBox "Eingegebenens Startdatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Startdatum fehlt!"
Exit Sub
End If
varAntwort = InputBox("Bitte Endedatum des Zeitraums eingeben:", "Endedatum")
If varAntwort  "" Then
If IsDate(varAntwort) Then
datEnde = CDate(varAntwort)
Second_Match = datEnde
Else
MsgBox "Eingegebenens Endedatum fehlerhaft!"
Exit Sub
End If
Else
MsgBox "Endedatum fehlt!"
Exit Sub
End If
End Sub
'//Find the Match
'//We convert the Date to a Long, because Match wont work with normal date objects
Private Function MatchThis(ByVal Match_ As Variant, ws As Worksheet, rng As Range)
With ws
With Application
If Not VBA.IsError(.Match(CLng(Match_), rng, 0)) Then
MatchThis = .Match(CLng(Match_), rng, 0)
End If
End With
End With
End Function
'//Export the created Range to the given sheet
Private Sub ExportToSheet(ByVal SheetName As String, ByVal Range_ As Range)
Dim worksheet_ As Worksheet
Dim lRow As Long
Set worksheet_ = ThisWorkbook.Sheets(SheetName)
With worksheet_
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & lRow).Resize(Range_.Rows.Count, Range_.Columns.Count) = Range_.Value
End With
End Sub

AW: Kopieren von Zeilen zwischen zwei Datumsangaben

29.09.2017 16:24:12

Zeilen

Hallo Peter,
nicht übel, dein Code. Die Krux ist nur, dass bei Datumseingaben, die nicht exakt den Daten im Blatt "Archiv" entsprechen, weder ein Resultat erzeugt wird, noch eine Meldung erfolgt.
Beispiel: 01.01.2017 bis 19.05.2017 oder 16.01.2017 bis 31.08.2017.
Ich hatte mich auch schon mit Oliver's Frage beschäftigt, bin aber schließlich zu dem Schluss gekommen, dass es vermutlich sinnvoller ist, die Datumseingaben (von/bis) per MouseClick über eine Listbox abzufragen.
Und noch zwei Anmerkung nebenbei:
Vor dem Kopieren der Daten in Tabelle "Auswahl" müssen natürlich die Zeilen mit "alten" Daten unterhalb der Überschrift gelöscht werden!
Als NICE-TO-HAVE wäre es schön, wenn nach Bestätigung von "Done" das Blatt
"Auswahl" angezeigt würde.
Ich hoffe, du fasst meine Anmerkungen nicht als Negativ-Kritik auf!
Gruß, Rolf

Danke für Kritik

29.09.2017 17:05:18

Peter(silie)

Hallo,
keines Falls nehme ich dir diese Kritik übel, die war schließlich konstruktiv und nicht destruktiv!
Gebe dir völlig recht mit dem Datumsproblem, und die ListBox Idee ist auch nicht schlecht.
An die beiden anderen Punkte hatte ich gar nicht gedacht, danke auch hier für den Hinweis.
Schönes Wochenende!

Beliebteste Forumthreads (12 Monate)

Kopieren von Zeilen zwischen zwei Datumsangaben

Forumthread: Kopieren von Zeilen zwischen zwei Datumsangaben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread