|
Hallo,
teste mal:
Option Explicit
Public Sub aaa()
Dim varStart As Variant, varEnde As Variant
Dim loStart As Long, loEnde As Long
Dim loZeile As Long, loSpalte As Long
Do
varStart = InputBox("Bitte Startdatum im Format XX.XX.XXXX eingeben.", "Startdatum erfassen")
If varStart = "" Then Exit Sub
If Not IsDate(varStart) Then MsgBox "Fehler: Wert ist kein gültiges Datum."
Loop Until IsDate(varStart)
loStart = CLng(CDate(varStart))
Do
varEnde = InputBox("Bitte Enddatum im Format XX.XX.XXXX eingeben.", "Enddatum erfassen")
If varEnde = "" Then Exit Sub
If Not IsDate(varEnde) Then MsgBox "Fehler: Wert ist kein gültiges Datum."
Loop Until IsDate(varEnde)
loEnde = CLng(CDate(varEnde))
'Blattname anpassen
With Worksheets("Tabelle1")
loZeile = .Cells(.Rows.Count, "F").End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).FormulaLocal = _
"=WENN(UND($F2>" & loStart & ";$F2<" & loEnde & ");ZEILE();0)"
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value = _
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value
.Cells(1, loSpalte) = 0
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).RemoveDuplicates Columns:=loSpalte, Header:=xlNo
.Columns(loSpalte).ClearContents
End With
End Sub
Das Makro setzt voraus, dass deine eigentlichen Daten erst in Zeile 2 beginnen und in Zeile 1 Überschriften vorhanden sind.
Gruß Werner
|