AW: Beispieldatei ?
23.10.2014 17:32:14
Daniel
Hi
anbei zwei Codes, die dir die Zuammenfassung der Zellen erledigt.
der erste Code sind klassisch verbundene Zellen (so wie wenn du die Zellen markierst und verbindest).
Hierbei werden die Inhalte der Verbundenen Zellen gelöscht, ausser in der ersten Zelle des Verbundes.
das hat nachteile, weil es jetzt nicht mehr möglich ist, die Tabelle zu filtern oder mit Formeln nach dem Monat auszuwerten.
der zweite Code verwendet eine andere Methode den Zellverbund zu erstellen.
hierbei wird in einem leeren Zellbereich ein gleich grosser Zellverbund mit leeren zellen gebildet und dann wird von diesem Zellverbund das Format auf die eigentlichen Zellen übertragen.
Dabei werden diese Zellen dann auch verbunden, aber ihr eigentlicher Inhalt bleibt erhalten, so dass man diese Spalte weiterhin für den Autofilter oder Sortierungen verwenden kann und das trotz verbundener Zellen:
Option Explicit
Sub Umformen1()
Dim Zelle1 As Range
Dim Zelle2 As Range
Set Zelle1 = Cells(3, 1)
Do While Zelle1.Value ""
Set Zelle2 = Columns(1).Find(what:=Zelle1.Value, _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchdirection:=xlPrevious)
Range(Zelle1.Offset(2, 0), Zelle2).ClearContents
With Range(Zelle1.Offset(1, 0), Zelle2)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
.MergeCells = True
End With
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End Sub
Sub Umformen2()
Dim sp As Long
Dim Zelle1 As Range
Dim Zelle2 As Range
sp = ActiveSheet.UsedRange.Columns.Count + 1
Set Zelle1 = Cells(3, 1)
Do While Zelle1.Value ""
Set Zelle2 = Columns(1).Find(what:=Zelle1.Value, _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchdirection:=xlPrevious)
With Range(Zelle1.Offset(1, 0), Zelle2)
With .Offset(0, sp)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlVertical
.MergeCells = True
.Copy
End With
.PasteSpecial xlPasteFormats
.Offset(0, sp).MergeCells = False
.Offset(0, sp).ClearFormats
End With
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
End Sub
Gruß Daniel