Zellen Mergen und Datumseingabe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Testweise() Dim i As Integer, a As Integer Dim n As Integer For n = 4 To 5 For i = 2 To 400 If Cells(n, i).DisplayFormat.Interior.ColorIndex = 8 Then a = a + 1 If Cells(n, i + 1).DisplayFormat.Interior.ColorIndex 8 Then Cells(n, i).Offset(0, -a + 1).Resize(, a).MergeCells = True a = 0 End If End If Next Next End Sub

Hi
mal grundsätzliche Tipps:
wenns nur darum geht die zwischenlinien weg zu bekommen, dann geht das auch ohne Verbundzellen.
auch das Anzeigen des Datums müsste problemlos gehen.
einzige Voraussetzung: die Liste in Tabelle2 muss nach Datum aufsteigend sortiert sein.
die Färbung regelst du dann so über 3 bedingte Formate.
1. Format: Hintergrund hellblau, Rahmen oben und unten, für Rahmen rechts und links keine Setzung
Regel: =UND(B3&gt=SVERWEIS(B3;Tabelle2!$B:$B;1;1);B3&lt=SVERWEIS(B3;Tabelle2!$B:$C;2;1))
2. Format: nur Rahmen links
Regel: =B3=SVERWEIS(B3;Tabelle2!$B:$B;1;1)
3. Format: nur Rahmen rechts
Regel: =B3=SVERWEIS(B3;Tabelle2!$B:$C;2;1)
das sieht dann schon passend aus.
Die Formeln funktionieren so für eine beliebige Anzahl von Kalendereinträgen.
Wichtig ist nur die aufsteigende Sortierung, sonst funktioniert das mit dem SVerweis nicht.
Das Datum dann im Kalender anzeigen zu lassen wird schwierig und geht nur per VBA, bzw einem Makro, dass die Daten aktualisiert, wenn du den Kalender änderst. Das Problem ist, dass die Werte nur dann angezeigt werden, wenn die dahinterliegenden Zellen frei sind, das schließt dann Formeln aus.
ich würde das so machen:
1. Färbung und Rahmenlinien nur über Bedingte Formatierung, so wie gezeigt, keine Verbundzellen!
2. das Anzeigen der Datumswerte aus der Tabelle machst du dann mit folgendem Makro:
dim Zelle as Range


Sheets("Tabelle1").Range("B3:NB4").ClearContents
for each Zelle in Sheets("Tabelle2").Columns(2).SpecialCells(xlcelltypeconstants, 1)
With Sheets("Tabelle1").Range("B3")
.Offset(0, Zelle.Value - .Value).Value = Format(Zelle.Value, "DD.MM") & " - " & Format(Zelle.Offset(0, 1).Value, "DD.MM")
end with
Next

dieses Makro muss dann immer laufen, wenn du in Tabelle2 was am Kalender änderst.
Gruß Daniel

Sub test() Sheets("Tabelle1").Range("B4:NB4").ClearContents For Each Zelle In Sheets("Tabelle2").Columns(2).SpecialCells(xlCellTypeConstants, 1) With Sheets("Tabelle1").Range("B3") .Offset(1, Zelle.Value - .Value).Value = Format(Zelle.Value, "DD.MM") & " - " & Format(Zelle.Offset(0, 1).Value, "DD.MM") End With Next End Sub

Hallo Dominic
ich würde ganz auf die MergeCells verzichten - wenn du die löschst, werden deine Gültigkeitsbereiche der bedingten Formatierung
zerpflückt und dann herrscht irgendwann Chaos.
probiers mal mit CenterAcrossSelection, siehe Code
Sub Testweise()
Dim i As Integer, a As Integer
Dim n As Integer
Dim strTemp As String
With Worksheets(1)
For n = 4 To 5
.Rows(n).ClearContents
For i = 2 To 400
If .Cells(n, i).DisplayFormat.Interior.ColorIndex = 8 Then
If .Cells(n, i - 1).DisplayFormat.Interior.ColorIndex 8 Then strTemp = Format(.Cells(3, i), "d.m.")
a = a + 1
If .Cells(n, i + 1).DisplayFormat.Interior.ColorIndex 8 Then
.Cells(n, i).Offset(0, -a + 1) = strTemp & "-" & Format(.Cells(3, i), "d.m.")
.Cells(n, i).Offset(0, -a + 1).Resize(, a).HorizontalAlignment = xlCenterAcrossSelection
a = 0
End If
End If
Next
Next
End With
End Sub
..und die Regel für die bedingte Formatierung geht kürzer:


=SUMME((B3>=Tabelle2!$B$2:$B$20)*(B3

Gruß Rolf

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread