12.04.2018, 09:18
(07.04.2018, 23:31)LuckyJoe schrieb: Hallo Timon,
ich teile auch die Ansicht von Klaus-Dieter, da verbundene Zellen viele Probleme bereiten können.
Dennoch hier eine Lösung, die man sicherlich noch eleganter hinbekommt:
Code:Sub KW_verbinden()
Dim KWZeile As Integer
Dim StartSpalte As Byte
Dim KWlSpalte As Byte
Dim Spalte As Byte
Dim KWNeu As Byte
Application.DisplayAlerts = False
KWZeile = 4
StartSpalte = 2
KWlSpalte = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
KWNeu = StartSpalte
For Spalte = StartSpalte To KWlSpalte
If Cells(KWZeile, Spalte) <> "" Or Spalte = KWlSpalte Then
If KWNeu < Spalte Then
If Spalte <> KWlSpalte Then
With Range(Cells(KWZeile, KWNeu), Cells(KWZeile, Spalte - 1))
.HorizontalAlignment = xlCenter
.MergeCells = False
.Merge
End With
Else
With Range(Cells(KWZeile, KWNeu), Cells(KWZeile, Spalte))
.HorizontalAlignment = xlCenter
.MergeCells = False
.Merge
End With
End If
KWNeu = Spalte
End If
End If
Next
Application.DisplayAlerts = True
End Sub
Viel Erfolg
So habe es nun nochmal versucht und war meine Dummheit die es nicht hat funktionieren lassen :16:
Jedoch hatte ich das Problem, dass sämtliche Zellen Verbunden wurden und die KW 52 rein geschrieben wird.
Gibt es einen Befehl den man noch einbauen könnte, der bei Jeder Zelle mit einem Inhalt endet und danach weiter macht? so dass alle KW angezeigt werden.
Liebe Grüsse
Timon