Kennzeichnung von bestimmtem Tagesdatum

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

D1: 9 D2: 25 A1: 28.12. (2009 = Montag) A2: 29.12. (2009 = Dienstag) A3: 30.12. (2009 = Mittwoch) A4: 31.12. (2009 = Donnerstag) A5: 01.01. (2010 = Freitag) A6: 02.01. (2010 = Samstag) A7: 03.01. (2010 = Sonntag) A8: 04.01. (2010 = Montag) A9: 05.01. (2010 = Dienstag) A10: 06.01. (2010 = Mittwoch) A11: 07.01. (2010 = Donnerstag) A12: 08.01. (2010 = Freitag) A13: 09.01. (2010 = Samstag) A14: 10.01. (2010 = Sonntag) A57: 21.02. (2010 = Sonntag) A58: 22.02. (2010 = Montag) A59: 23.02. (2010 = Dienstag) A60: 24.02. (2010 = Mittwoch) A61: 25.02. (2010 = Donnerstag) A62: 26.02. (2010 = Freitag) u.s.w.

Sub verBinden() Dim sTart As Long Dim enDe As Long Dim zeLLen() As Long Dim zeiLe As Long Dim anFang As Boolean ' True sucht Anfang, False sucht Ende Const suchSp = 1 ' Spalte A Const sumSp = 2 ' Spalte B Const verbSp = 3 ' Spalte C ' Erstinitialisierung ReDim zeLLen(-1 To 0, 0 To 0) ' Sucht erst einen Anfang anFang = True ' Nimmt das aktive Blatt With ActiveSheet ' Alle Zellverbindungen weg .Columns(verbSp).UnMerge ' Start und Ende einlesen sTart = .Cells(2, 4).Value enDe = .Cells(3, 4).Value ' Nun durchsuchen For zeiLe = 1 To .Cells(Rows.Count, suchSp).End(xlUp).Row If IsDate(.Cells(zeiLe, suchSp)) Then ' Wenn Anfang oder Ende (festgelegt durch anfend) If Day(.Cells(zeiLe, suchSp)) = IIf(anFang, sTart, enDe) Then ' Zwischenspeichern If anFang Then If UBound(zeLLen, 2) = 0 Then ReDim zeLLen(-1 To 0, 1 To 1) Else ReDim Preserve zeLLen(-1 To 0, 1 To UBound(zeLLen, 2) + 1) End If End If zeLLen(anFang, UBound(zeLLen, 2)) = zeiLe anFang = Not anFang End If End If Next ' Nun verbinden, wenn es was zu verbinden gibt Application.ScreenUpdating = False Application.DisplayAlerts = False For zeiLe = 1 To UBound(zeLLen, 2) If zeLLen(-1, zeiLe)

Hallo Jogy,
danke.
Funktioniert bedingt:
Da Du die Zell-, Zeilen- und Spaltenbezeichung aus meinem Beispiel übernommen hast, habe sie angepasst:

Const suchSp = 3 ' Spalte C
Const sumSp = 6 ' Spalte F
Const verbSp = 8 ' Spalte H
' Start und Ende einlesen
sTart = .Cells(8, 8).Value 'H8
enDe = .Cells(10, 8).Value 'H10

Habe ich eine Stelle vergessen?
Nachdem ich den Code aktiviert habe wurden alle jeweiligen Zellen in der H-Spalte zwischen dem 24. und dem nächsten 23. verbunden. Auch die Addition funktioniert prima.
Allerdings müssten folgende Dinge noch angepasst werden:
1. Es wurden sämtliche anderen Zellverbindungen des Tabellenblattes "zerschossen". Hebt die Erstinitialisierung sämtliche Zellverbindungen auf, bevor dann die entsprechenden Zellen in der H-Spalte wieder verbunden werden?

' Erstinitialisierung
ReDim zeLLen(-1 To 0, 0 To 0)

2. Die ersten und die letzten Bereiche wurden jeweils nicht verbunden. Wahrscheinlich, weil dort kein Anfang mit 24 (oberster Bereich von Anfang bis 23 - Tabelle beginnt ja mit den letzten Dezembertagen in der ersten Woche, damit die Woche voll ist) und kein Ende mit 23 (unterster Bereich von 24 bis Ende -, Tabelle endet mit den ersten Januartagen des Folgejahres, bis die Woche voll ist) vorhanden ist.
3. Ich hatte in meinem Beispiel vergessen, eine Zelle anzugeben, in der die Jahreszahl steht. Sie befindet sich in der Zelle F1. Daher gibt es wohl auch keine Änderung der Zellverbindungen und der Formel, wenn ich die Jahreszahl ändere und sich damit die Grenzdaten verschieben?
4. Der Bereich, in dem die Zellen verbunden werden sollen bezieht sich nicht nur auf die Spalte H sondern auf H und I. Dass heisst, dass alle Zellen in der H- und I-Spalte, die sich zwischen den Zeilen der jeweiligen Tagesdaten 24 und 23 befinden, sollen verbunden und die Additionsformel entsprechend angepasst werden.
Aber trotz alledem: Hochachtung und Danke für die bisherige Hilfe!!!
Gruß
Stein

Hallo Stein,
zu 1.
Sollte eigentlich nicht passieren. Die Erstinitialisierung hat mit den Zellverbindungen erstmal nichts zu tun, es werden allerdings an anderer Stelle die vorhandenen Zellverbindungen in der verbSp aufgehoben. Das macht das .UnMerge. In anderen Spalten darf eigentlich nichts passieren.
zu 2.
Wenn es keinen Anfang oder Ende findet, dann passiert nichts. Habe ich geändert.
zu 3.
siehe unten
zu 4.
Erledigt.
Noch eine allgemeine Anmerkung: Es ist ziemlich ungeschickt, die Werte für Start und Ende in die Spalte einzutragen, die nachher verbunden wird. Da solltest Du eine andere Spalte wählen. Ich habe jetzt mal J genommen. Ansonsten müsste ich das anpassen, da die Spalten H und I komplett gelöscht werden (die alten Formeln müssen ja weg).
Das hier in ein allgemeines Modul:

Sub verBinden(myWsh As Worksheet)
Dim sTart As Long
Dim enDe As Long
Dim zeLLen() As Long
Dim zeiLe As Long
Dim tempCalc As Long
Dim endZeile As Long
Dim anFang As Boolean ' True sucht Anfang, False sucht Ende
Const suchSp = 3 ' Spalte C
Const sumSp = 6 ' Spalte F
Const fverbSp = 8 ' Spalte H
Const lverbSp = 9 ' Spalte I
Const startZeile = 2 ' erste Zeile mit Datumswerten
' Erstinitialisierung
ReDim zeLLen(-1 To 0, 0 To 0)
' Sucht erst einen Anfang
anFang = True
' Nimmt das übergebene Blatt
With myWsh
With Range(.Columns(fverbSp), .Columns(lverbSp))
' Alle Zellverbindungen weg
.UnMerge
' Und auch die Inhalte weg
.ClearContents
End With
' Start und Ende einlesen
sTart = .Cells(2, 10).Value ' J2
enDe = .Cells(3, 10).Value ' J3
' letzte Zeile bestimmen
endZeile = .Cells(Rows.Count, suchSp).End(xlUp).Row
' Nun durchsuchen
For zeiLe = startZeile To endZeile
If IsDate(.Cells(zeiLe, suchSp)) Then
' Wenn Anfang oder Ende (festgelegt durch anfend)
If Day(.Cells(zeiLe, suchSp)) = IIf(anFang, sTart, enDe) Then
' Zwischenspeichern
If anFang Then
If UBound(zeLLen, 2) = 0 Then
ReDim zeLLen(-1 To 0, 1 To 1)
Else
ReDim Preserve zeLLen(-1 To 0, 1 To UBound(zeLLen, 2) + 1)
End If
End If
zeLLen(anFang, UBound(zeLLen, 2)) = zeiLe
anFang = Not anFang
' Sucht jetzt noch das Ende, wenn noch kein Anfang gefunden wurde
ElseIf UBound(zeLLen, 2) = 0 And Day(.Cells(zeiLe, suchSp)) = enDe Then
ReDim zeLLen(-1 To 0, 1 To 1)
zeLLen(0, 1) = zeiLe
End If
End If
Next
' Nun verbinden, wenn es was zu verbinden gibt
Application.ScreenUpdating = False
Application.DisplayAlerts = False
tempCalc = Application.Calculation
Application.Calculation = xlCalculationManual
For zeiLe = 1 To UBound(zeLLen, 2)
' Ende da, aber kein Anfang (nur für 1. Wert!)
If zeLLen(-1, zeiLe) = 0 And zeiLe = 1 Then
zeLLen(-1, zeiLe) = startZeile
' Anfang da, aber kein Ende (nur für letzten Wert!)
ElseIf zeLLen(0, zeiLe) = 0 And zeiLe = UBound(zeLLen, 2) Then
zeLLen(0, zeiLe) = endZeile
End If
' Prüfen ob Verbindung sinnvoll und dann verbinden
If zeLLen(-1, zeiLe)

Und das hier in den Code der Tabelle:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F1")) Is Nothing Then
Call verBinden(Me)
End If
End Sub

Gruß, Jogy

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	F	G	H	I	J	K	M
56	6	Mo	08.02.	KKW Biblis	1,25	5,00			2,00	3,00
57		Di	09.02.	KKW Biblis	1,25
58		Mi	10.02.	KKW Biblis	1,25
59		Do	11.02.	KKW Biblis	1,25
60		Fr	12.02.	KKW Biblis	0,00
61		Sa	13.02.
62		So	14.02.
63	7	Mo	15.02.		-8,31	-4,56			2,00	0,00	X
64		Di	16.02.	KKW Biblis	1,25
65		Mi	17.02.	KKW Biblis	1,25
66		Do	18.02.	KKW Biblis	1,25
67		Fr	19.02.	KKW Biblis	0,00
68		Sa	20.02.
69		So	21.02.
70	8	Mo	22.02.	KKW Biblis	1,25	6,00			2,00	4,00
71		Di	23.02.	KKW Biblis	1,25
72		Mi	24.02.	KKW Biblis	1,25
73		Do	25.02.	KKW Biblis	0,00
74		Fr	26.02.	KKW Biblis	2,25
75		Sa	27.02.
76		So	28.02.

Kennzeichnung von bestimmtem Tagesdatum

29
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kennzeichnung von bestimmtem Tagesdatum

29 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

29
Beiträge zum Forumthread

Beiträge zu diesem Forumthread