AW: Fehlstellen Zeilen einfügen
10.01.2016 17:21:13
Daniel
HI
hier nochmal eine Codealternative, mit einem etwas anderem Lösungansatz, welchen man bei Bedarf auch manuell, mit wenigen Klicks auführen kann:
Sub test()
With Columns(1).SpecialCells(xlCellTypeConstants, 1).Offset(0, 3)
.FormulaR1C1 = "=Date(Year(RC1), Month(RC1), 1)"
.Formula = .Value
.RemoveDuplicates 1, xlNo
.Cells(1, 1).Offset(0, 1) = WorksheetFunction.Min(.Cells)
.Cells(1, 1).Offset(0, 1).DataSeries Rowcol:=xlColumns, _
Type:=xlChronological, Date:=xlMonth, Step:=1, _
Stop:=WorksheetFunction.Max(.Cells), Trend:=False
With .Cells(1, 1)
Range(.Offset(0, 1), .Offset(0, 1).End(xlDown)).Copy
.End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Range(.Cells, .End(xlDown)).RemoveDuplicates 1, xlNo
On Error GoTo weiter
Selection.SpecialCells(xlCellTypeConstants, 1).Copy
On Error GoTo 0
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
Selection.Offset(0, 1).Value = 0
Selection.NumberFormat = Selection.Cells(1).Offset(-1, 0).NumberFormat
Columns(1).SpecialCells(xlCellTypeConstants, 1).Resize(, 2).Sort _
key1:=Cells(1, 1), order1:=xlAscending, Header:=xlNo
weiter:
.EntireColumn.Resize(, 2).ClearContents
End With
End With
End Sub
eine Anpassung an Kalenderwochen dürfte auch nicht so schwer sein, wenn in Spalte A die Kalenderwoche als Zahl von 1-52 steht.
angepasst werden müssten dann diese beiden Programmzeilen:
.FormulaR1C1 = "=Date(Year(RC1), Month(RC1), 1)"
.Cells(1, 1).Offset(0, 1).DataSeries Rowcol:=xlColumns, _
Type:=xlChronological, Date:=xlMonth, Step:=1, _
Stop:=WorksheetFunction.Max(.Cells), Trend:=False
hier würde dann ausreichen:
.FormulaR1C1 = "=RC1"
und
.Cells(1, 1).Offset(0, 1).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Step:=1, _
Stop:=WorksheetFunction.Max(.Cells), Trend:=False
gruss Daniel