AW: Spalte einfügen und Monat hinterlegen
13.10.2011 13:16:42
Tino
Hallo,
kannst mal testen, Tabelle im Code noch anpassen.
Sub Start()
Dim rngAnfang As Range, rngEnde As Range, rngBereich As Range
Dim n&
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
With Tabelle1 'Tabelle anpassen <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Set rngBereich = .Range("A3", .Cells(.Rows.Count, 1).End(xlUp))
rngBereich.Insert Shift:=xlToRight
Set rngBereich = rngBereich.Offset(0, -1)
With rngBereich
.FormulaR1C1 = "=IF(RC[1]<>"""",MONTH(RC[1]),"""")"
.Value = .Value
For n = 1 To 12
Set rngAnfang = .Find(What:=n, After:=.Cells(.Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set rngEnde = .Find(What:=n, SearchDirection:=xlPrevious)
If Not rngAnfang Is Nothing Then
If Not rngEnde Is Nothing Then
With Range(rngAnfang, rngEnde)
.MergeCells = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
.Value = MonthName(n, False)
With .Font
.FontStyle = "Fett"
.Size = 15
End With
End With
End If 'rngEnde
End If 'rngAnfang
Set rngAnfang = Nothing: Set rngEnde = Nothing
Next n
End With
End With
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Gruß Tino