252 Aufrufe
Gefragt in Tabellenkalkulation von tmd Einsteiger_in (13 Punkte)
Hi,

will eine einfache Urlaubsplanung für 10 Mitarbeiter erstellen. Sie schaut wie folgt aus:

B-Z (ist nur ein Anhalt, nicht die tatsächliche Spaltenanzahl) sind die Tage und Monate Jan-Dez.

Spalte A2-A11 sind die Namen der Mitarbeiter. In seiner Zeile soll jeder seinen Ulaub als "U" eintragen. Das Feld soll danach grün werden. Haben bereits 2 ihren Urlaub am selben Tag eingetragen, soll das Feld mit dem dritten usw. "U" rot ausgefüllt werden.

Unter der Tabelle stehen in Zeile A15-A24 die Namen der Mitarbeiter, B15-B25 der zur Verfügung stehende Jahresurlaub, Zeile C15-C25 stehen die noch zur verfügung stehenden Urlaubstage,sprich: 35 aus Spalten B minus den eingetragenen "U"s aus der oberen Tabelle.

Hoffe, ich habe mich einigermassen einleuchtend ausgedrückt.

Danke schon mal für Eure Hilfe und Mühe

4 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
Bearbeitet von nighty
Hallo Community

Bin leider fast Blind geworden(im wahrsten Sinne des Wortes Blind geschrieben),daher nicht optimiert!
Ich werde auch die Forenhilfe langsam einstellen müssen!

Gruß Nighty

1 Zeile Überschriften bzw Datum

Spalte a = Namen(Händiche Eingabe)

Spalte b = Gesamturlaub(Händiche Eingabe)

Spalte c= Resturlaub(Wird vom Makro berechnet)

Ab Spalte D händiche Eingabe von "u"

Beide Farbmarkierungen werden mit einer leeren Zelle wieder gelöscht bzw der Resturlaub zurück gerechnet

Einzufügen

Alt+F11/Projectexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Row > 1 And Target.Column > 3 Then
        If WorksheetFunction.CountIf(Columns(Target.Column), "u") < 3 And Cells(Target.Row, Target.Column) <> "" Then
            Cells(Target.Row, 3) = Cells(Target.Row, 2) - WorksheetFunction.CountIf(Rows(Target.Row), "u")
            Cells(Target.Row, Target.Column).Interior.ColorIndex = 6
        End If
        If WorksheetFunction.CountIf(Columns(Target.Column), "u") > 2 Then
            Cells(Target.Row, Target.Column).Interior.ColorIndex = 3
        End If
        If WorksheetFunction.CountIf(Columns(Target.Column), "u") = 2 And Cells(Target.Row, Target.Column) = "" Then
            Cells(Target.Row, Target.Column).Interior.ColorIndex = xlNone
        End If
        If Cells(Target.Row, Target.Column).Interior.ColorIndex = 6 And Cells(Target.Row, Target.Column) = "" Then
            Cells(Target.Row, Target.Column).Interior.ColorIndex = xlNone
            Cells(Target.Row, 3) = Cells(Target.Row, 3) + 1
        End If
    End If
    Application.EnableEvents = True
End Sub
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
Hallo

Vielleicht kannst du das ja noch gebrauchen!

Feiertage werden mit einem Kommentar versehen!

Gruß Nighty

Einmaliger lauf,danach kann die Function und das Modul wieder gelöscht werden

Selektiere einen beliebigen Bereich (in deinem Fall,die erste Zeile(Datumsreihe))

Makrostart

Alle Feiertage werden mit einen Kommentarfeld versehen und Namentlich in diesen angezeigt

Sub Feiertage_im_Kommentarfeld()
    Dim Zelle As Object, Eintrag As Object
    For Each Zelle In Selection
        If IsDate(Zelle) And Feiertag2(Range(Zelle.Address)) <> "" Then
            Set Eintrag = Range(Zelle.Address).Comment
            If Eintrag Is Nothing Then
                Range(Zelle.Address).AddComment
                Range(Zelle.Address).Comment.Text Text:="Feiertag:" & Chr(10) & Feiertag2(Range(Zelle.Address))
            Else
                Range(Zelle.Address).ClearComments
                Range(Zelle.Address).AddComment
                Range(Zelle.Address).Comment.Text Text:="Feiertag:" & Chr(10) & Feiertag2(Range(Zelle.Address))
            End If
        End If
      
    Next Zelle
End Sub
Function Feiertag2(Zelle As Date) As String
    Dim DatumString As String
    Dim IntYear As Integer, OsterDatum As Integer
    IntYear = Year(Zelle)
    OsterDatum = (((255 - 11 * (IntYear Mod 19)) - 21) Mod 30) + 21
    DatumString = _
    DateSerial(IntYear, 1, 1) & _
                  DateSerial(IntYear, 1, 6) & _
                  DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) - 2 & _
                  DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 1 & _
                  DateSerial(IntYear, 5, 1) & _
                  DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 39 & _
                  DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 50 & _
                  DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 60 & _
                  DateSerial(IntYear, 10, 3) & _
                  DateSerial(IntYear, 11, 1) & _
                  DateSerial(IntYear, 12, 24) & _
                  DateSerial(IntYear, 12, 25) & _
                  DateSerial(IntYear, 12, 26) & _
                  DateSerial(IntYear, 12, 31) & _
                  "31.10.2017"
    FName = Array("Neujahr", "Dreikönig", "Karfreitag", "Ostermontag", "Tag der Arbeit", "Christi Himmelfahrt", "Pfingstmontag", "Fronleichnam", "Tag der Einheit", "Allerheiligen", "Heiligabend", "1. Weihnachtstag", "2. Weihnachtstag", "Silvester", "Reform")
    If InStr(DatumString, Zelle) > 0 Then Feiertag2 = FName(InStr(DatumString, Zelle) / 10)
End Function
0 Punkte
Beantwortet von tmd Einsteiger_in (13 Punkte)
Hi,

Danke für die Mühe, hätte vllt. vorab schreiben müssen, dass betriebsbedingt bei uns keine Makros zugelassen sind.

Gruss
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
Hallo

Die Datenbank wird sich freuen :-)

Wo bleiben unsere Formelfreaks .-)

Ich könnte mir eine Lösung mit der Bedingte Formatierung und Zählenwenn vorstellen!

Allerdings simd mir die Limitierungen dieser bei verschiedenen Excelversionen nicht geläufig!

Gruß Nighty
...