Hallo zusammen
ich [xurl=
http://jamaipa.de|Jamaipa - Suche ohne Spam und Shops]suche[/url] eine Möglichkeit identische Zellen automatisch per VBA verbinden zu lassen. Einen funktionierenden Code (siehe unten) habe ich hier bereits im [xurl=
http://www.supportnet.de|Supportnet - Computer und Internet Forum]Forum[/url] gefunden.
Für mein Problem passt es aber leider noch nicht ganz. Ich versuche damit auf Basis von einzelnen Tagen eine Jahresübersicht (Anzeige von Jahr, Monat und KW) zu generieren.
Zur Verdeutlichung
in Zeile A steht das Datum (z.B. A1: 01.01.18, A2: 02:01.18, usw.)
in Zeile B steht das zugehörige Jahr (also 365 mal 2018, dann 2019, usw.)
in Zeile C steht der zugehörige Monat (also 31 mal Januar, 30 mal Februar, usw.)
in Zeile D steht die zugehörige KW
Das Start und Zieldatum ändere ich in einem anderen Feld, wodurch sich die Darstellung jederzeit ändern lässt. Über den VBA-Code funktioniert die Zentrierung der identischen Zellen leider nur einmal... denn sobald ich das Start und Enddatum ändere, passt die Verbindung nicht mehr.
Funktioniert das ganze, wenn ich die Zeilen B, C und D so belasse und mir die Felder in 3 zusätzlichen Zeilen verbinden lasse?
Falls ja, wie muss ich den Code bearbeiten, dass er mir die Jahre, Monate und KW in jeweils einer neuen Zeilen (E, F und G) verbindet, sodass ich jederzeit das Start und Zieldatum ändern kann?
Außerdem suche ich noch nach einer Lösung, die verbundenen Zellen zu zentrieren ;)
Sub verbbindeZellen()
Dim Spalte As Integer
Dim Startspalte As Integer
Dim Endspalte As Integer
Dim Wert As Variant
Dim X As Integer
Const Maxspalte As Integer = 100
Dim Arbeitsblatt As Worksheet
Startspalte = 1
Set Arbeitsblatt = ThisWorkbook.ActiveSheet
With Arbeitsblatt
For Spalte = 1 To Maxspalte
If Cells(10, Spalte) <> Wert Then
Endspalte = Spalte - 1
If Startspalte < Endspalte And Wert <> "" Then
For X = Startspalte + 1 To Endspalte
Cells(10, X).Value = ""
Next X
Range(Cells(10, Startspalte), Cells(10, Endspalte)).Merge
End If
Startspalte = Spalte
Wert = Cells(10, Spalte).Value
End If
Next Spalte
End With
End Sub
Vielen Dank
Andi