AW: Worksheet_Change zusammenfassen aber wie?
25.05.2018 11:37:31
DJRidoo
Ich habe es noch geschafft und habe den Code, welcher vereinfacht und gekürzt dargestellt werden soll nun zusammengeschrieben. Den Code auf weitere Mitglieder zu erweitern bekomme ich dann wohl hin.
Es wäre super nett Gerd wenn du mir da helfen könntest. Es würde mich bei meinem privatem Projekt nach vorne bringen.
Private Sub Worksheet_Change(ByVal Target As Range)
' ############################################################################################## _
' WENN sich am Urlaub etwas ändert, DANN Urlaub für Mitglied eintragen
' ############################################################################################## _
' Start Bildschirmaktualisierung deaktivieren
Application.ScreenUpdating = False
' Ende Bildschirmaktualisierung deaktivieren
' Start Urlaub für Mitglied 1 eintragen
If Not Application.Intersect(Target, Range("O14:AQ14")) Is Nothing Then
With Worksheets("Urlaub")
' für Urlaub 1
If .Range("O14").Value = .Range("P14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("O14").Value "" And .Range("P14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 2
If .Range("R14").Value = .Range("S14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("R14").Value "" And .Range("S14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 3
If .Range("U14").Value = .Range("V14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("U14").Value "" And .Range("V14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 4
If .Range("X14").Value = .Range("Y14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("X14").Value "" And .Range("Y14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 5
If .Range("AA14").Value = .Range("AB14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AA14").Value "" And .Range("AB14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 6
If .Range("AD14").Value = .Range("AE14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AD14").Value "" And .Range("AE14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 7
If .Range("AG14").Value = .Range("AH14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AG14").Value "" And .Range("AH14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 8
If .Range("AJ14").Value = .Range("AK14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AJ14").Value "" And .Range("AK14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 9
If .Range("AM14").Value = .Range("AN14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AM14").Value "" And .Range("AN14").Value "" Then
GoTo UrlaubMitglied1
End If
' für Urlaub 10
If .Range("AP14").Value = .Range("AQ14").Value Then
GoTo UrlaubMitglied1
End If
If .Range("AP14").Value "" And .Range("AQ14").Value "" Then
GoTo UrlaubMitglied1
End If
End With
End If
UrlaubMitglied1:
' Start Urlaub für Mitglied eintragen
For Spalte = 12 To 434
Select Case Spalte
Case 43, 44, 74, 75, 107, 108, 139, 140, 172, 173, 204, 205, 237, 238, _
270, 271, 302, 303, 335, 336, 367, 368, 400, 401, 402, 403
' keine Handlung
Case Else
With Worksheets("Jahresplan")
If .Cells(14, Spalte).Value "U" And .Cells(14, Spalte).Value "X" _
And _
Worksheets("HilfeUrlaub").Cells(214, Spalte).Value = True Then
.Cells(14, Spalte).Value = "U"
Else
If .Cells(14, Spalte).Value = "U" And _
Worksheets("HilfeUrlaub").Cells(214, Spalte).Value = False _
Then
.Cells(14, Spalte).Value = ""
End If
End With
End Select
Next Spalte
' Ende Urlaub für Mitglied eintragen
GoTo Ende
' Ende Urlaub für Mitglied 1 eintragen
' Start Urlaub für Mitglied 2 eintragen
If Not Application.Intersect(Target, Range("O15:AQ15")) Is Nothing Then
With Worksheets("Urlaub")
' für Urlaub 1
If .Range("O15").Value = .Range("P15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("O15").Value "" And .Range("P15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 2
If .Range("R15").Value = .Range("S15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("R15").Value "" And .Range("S15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 3
If .Range("U15").Value = .Range("V15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("U15").Value "" And .Range("V15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 4
If .Range("X15").Value = .Range("Y15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("X15").Value "" And .Range("Y15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 5
If .Range("AA15").Value = .Range("AB15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AA15").Value "" And .Range("AB15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 6
If .Range("AD15").Value = .Range("AE15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AD15").Value "" And .Range("AE15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 7
If .Range("AG15").Value = .Range("AH15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AG15").Value "" And .Range("AH15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 8
If .Range("AJ15").Value = .Range("AK15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AJ15").Value "" And .Range("AK15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 9
If .Range("AM15").Value = .Range("AN15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AM15").Value "" And .Range("AN15").Value "" Then
GoTo UrlaubMitglied2
End If
' für Urlaub 10
If .Range("AP15").Value = .Range("AQ15").Value Then
GoTo UrlaubMitglied2
End If
If .Range("AP15").Value "" And .Range("AQ15").Value "" Then
GoTo UrlaubMitglied2
End If
End With
End If
UrlaubMitglied2:
' Start Urlaub für Mitglied eintragen
For Spalte = 12 To 434
Select Case Spalte
Case 43, 44, 74, 75, 107, 108, 139, 150, 172, 173, 204, 205, 237, 238, _
270, 271, 302, 303, 335, 336, 367, 368, 400, 401, 402, 403
' keine Handlung
Case Else
With Worksheets("Jahresplan")
If .Cells(15, Spalte).Value "U" And .Cells(15, Spalte).Value "X" _
And _
Worksheets("HilfeUrlaub").Cells(215, Spalte).Value = True Then
.Cells(15, Spalte).Value = "U"
Else
If .Cells(15, Spalte).Value = "U" And _
Worksheets("HilfeUrlaub").Cells(215, Spalte).Value = False _
Then
.Cells(15, Spalte).Value = ""
End If
End With
End Select
Next Spalte
' Ende Urlaub für Mitglied eintragen
GoTo Ende
' Ende Urlaub für Mitglied 2 eintragen
' Start Urlaub für Mitglied 3 eintragen
If Not Application.Intersect(Target, Range("O16:AQ16")) Is Nothing Then
With Worksheets("Urlaub")
' für Urlaub 1
If .Range("O16").Value = .Range("P16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("O16").Value "" And .Range("P16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 2
If .Range("R16").Value = .Range("S16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("R16").Value "" And .Range("S16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 3
If .Range("U16").Value = .Range("V16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("U16").Value "" And .Range("V16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 4
If .Range("X16").Value = .Range("Y16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("X16").Value "" And .Range("Y16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 5
If .Range("AA16").Value = .Range("AB16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AA16").Value "" And .Range("AB16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 6
If .Range("AD16").Value = .Range("AE16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AD16").Value "" And .Range("AE16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 7
If .Range("AG16").Value = .Range("AH16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AG16").Value "" And .Range("AH16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 8
If .Range("AJ16").Value = .Range("AK16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AJ16").Value "" And .Range("AK16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 9
If .Range("AM16").Value = .Range("AN16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AM16").Value "" And .Range("AN16").Value "" Then
GoTo UrlaubMitglied3
End If
' für Urlaub 10
If .Range("AP16").Value = .Range("AQ16").Value Then
GoTo UrlaubMitglied3
End If
If .Range("AP16").Value "" And .Range("AQ16").Value "" Then
GoTo UrlaubMitglied3
End If
End With
End If
UrlaubMitglied3:
' Start Urlaub für Mitglied eintragen
For Spalte = 12 To 434
Select Case Spalte
Case 43, 44, 74, 75, 107, 108, 139, 160, 172, 173, 204, 205, 237, 238, _
270, 271, 302, 303, 335, 336, 367, 368, 400, 401, 402, 403
' keine Handlung
Case Else
With Worksheets("Jahresplan")
If .Cells(16, Spalte).Value "U" And .Cells(16, Spalte).Value "X" _
And _
Worksheets("HilfeUrlaub").Cells(216, Spalte).Value = True Then
.Cells(16, Spalte).Value = "U"
Else
If .Cells(16, Spalte).Value = "U" And _
Worksheets("HilfeUrlaub").Cells(216, Spalte).Value = False _
Then
.Cells(16, Spalte).Value = ""
End If
End With
End Select
Next Spalte
' Ende Urlaub für Mitglied eintragen
GoTo Ende
' Ende Urlaub für Mitglied 3 eintragen
Ende:
' Start Worksheet_Change aktivieren
Application.EnableEvents = True
' Ende Worksheet_Change aktivieren
End Sub
Ich danke dir Gerd.
MfG
DJRidoo