Ich habe ein Problem, dass mir arg zu schaffen macht. Ich denke es ist nur eine Kleinigkeit, aber ich sehe den Fehler nicht und bitte um Hilfe!!!!
Ich habe eine Datei, bei der im Sheet "Datenbank" in der Spalte A alle Tage eines Jahres aufgelistet werden, ohne Sa, So oder Wochwenfeiertagen.
Das Funktioniert, dank Rudi, auch perfekt.
Public Sub TAGE()
Dim datStart As Date, datEnd As Date
Dim lDay As Long
Dim iRow As Integer
datStart = DateSerial(Val(Sheets("Datenbank").Cells(1, 27)), 1, 1)
datEnd = DateSerial(Val(Sheets("Datenbank").Cells(1, 27)), 12, 31)
For lDay = datStart To datEnd
If Weekday(lDay, 2)
Function istFeiertag(Datum) As Boolean
Dim D As Integer, iJahr As Integer, dteOSo As Date
iJahr = Year(Datum)
D = (((255 - 11 * (iJahr Mod 19)) - 21) Mod 30) + 21
dteOSo = DateSerial(iJahr, 3, 1) + D + (D > 48) + _
6 - ((iJahr + iJahr \ 4 + D + (D > 48) + 1) Mod 7)
Select Case Datum
Case dteOSo - 2, _
dteOSo + 1, _
dteOSo + 39, _
dteOSo + 50, _
dteOSo + 60, _
DateSerial(iJahr, 1, 1), _
DateSerial(iJahr, 5, 1), _
DateSerial(iJahr, 10, 3), _
DateSerial(iJahr, 11, 1), _
DateSerial(iJahr, 12, 24), _
DateSerial(iJahr, 12, 25), _
DateSerial(iJahr, 12, 26), _
DateSerial(iJahr, 12, 31)
istFeiertag = True
End Select
'Karfreitag=Ostersonntag-2
'Ostermontag=Ostersonntag+1
'Chr.Himmelfahrt=Ostersonntag+39
'Pfingstmontag=Ostersonntag+50
'Fronleichnam=Ostersonntag+60
End Function
Bei folgendem Code trage ich in der Spalte A die Tage mit einem Zeilenabstand von 71 Zeilen ein.
Sheets("Datenbank").Cells(iRow * 71 - 70, 1) = Format(lDay, "dd/mm/yyyy")
Das Datum wird dann automatisch linksbündig in die Zelle eingetragen.
In den folgenden Spalten stehen Name von Bediensteten.
Nun versuche ich das Datum in Spalte A zu suchen und bei Übereinstimmung Zellen zu schreiben.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim I, J, A, B, C, D As Long
Dim RaBereich, RaBereich1 As Range
Set RaBereich = Range("H6:O76") 'Bereich der Wirksamkeit
If Intersect(Target, RaBereich) Is Nothing Then GoTo Schritt2 'Abbruch, wenn Aktion nicht im _
Zielbereich
I = Target.Row
J = Target.Column
For A = 1 To 65536
If Cells(6, 1) = Sheets("Datenbank").Cells(A, 1) Then
Sheets("Datenbank").Cells(A - 6 + I, J + 9).Value = Target.Cells
GoTo Ende
Else: End If
Next A
GoTo Ende
Schritt2:
On Error Resume Next
Set RaBereich1 = Range("A6") 'Bereich der Wirksamkeit
If Intersect(Target, RaBereich1) Is Nothing Then GoTo Ende 'Abbruch, wenn Aktion nicht im _
Zielbereich
Application.EnableEvents = False
Target.Cells.Select
I = Target.Row
J = Target.Column
For B = 1 To 65536
If Cells(6, 1) = Sheets("Datenbank").Cells(B, 1) Then
For D = 0 To 70
For C = 7 To 14
Cells(I + D, J + C) = Sheets("Datenbank").Cells(B + D, J + C + 9)
Next C
Next D
Application.EnableEvents = True
GoTo Ende
Else: End If
Next B
Ende:
Set RaBereich = Nothing 'Variable1 leeren
Set RaBereich1 = Nothing 'Variable2 leeren
Application.ScreenUpdating = True
End Sub
Das Funktioniert aber nur, wenn ich in der Spalte A die Zelle mit dem Datum mit der Maus aktiviere und die Zelle wieder verlasse!?!
Das Datum wird nach dem Verlassen rechtsbündig formatiert.
Dann funktioniert auch meine Filterung!?!
Warum ist das so?
Ich bitte um eure Mithilfe!!!!
LG
Dirk