Absenzenspiegel erstellen

Forumthread: Absenzenspiegel erstellen

09.10.2018 09:59:03

Richi

Guten Tag zusammen
Habe folgendes Problem und bräuchte eure gütige Unterstützung.
In Tabelle 1 habe ich vertical alle Mitarbeiter-Absenzen gelistet (es gibt nur eine
Absenz pro Tag egal wie lange diese gedauert hat).
In Tabelle 2 möchte ich die Absenzen (aus Tabelle 1) in Form eines Absenzenspiegels abbilden.
Spalte A (ab A10) = Name
Reihe 9 (ab B9) = Datum 1.1.18 - 31.12.2020 (sollte Variabel/veränderbar sein)
Makro sollte aus Tabelle 1 Name und Absenzdatum übernehmen und diese in Tabelle 2 unter dem selben Namen und entsprechendem Datum, bei diesem Schnittpunkt die Zelle "grün" einfärben.
Vielen Dank schon jetzt für eure Hilfe
Gruss Richi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Absenzenspiegel erstellen

09.10.2018 10:39:44

Richi

Nachtrag:
In Spalte B steht Beginn der Absenz
In Spalte C steht Ende der Absenz dieser Range sollte grün eingefärbt sein ab Schnittpunkt wie vorgängig beschrieben.

AW: Absenzenspiegel erstellen

09.10.2018 15:09:41

Richi

Pro Name können mehrere Zeilen an unterschiedlichen Daten vorhanden sein, nie aber zwei mit dem selben Datum

AW: Absenzenspiegel erstellen

09.10.2018 18:49:19

ChrisL

Hi Richi
Ein paar Tipps, damit vielleicht doch noch zu einer Lösung kommst.
Wenn du auf deinen eigenen Beitrag antwortest, dann solltest du wenigstens das Kontrollkästchen "offen" aktivieren.
Lade eine Beispieldatei.
Recherchiere und stelle ggf. eine konkrete Frage (da wo du gerade feststeckst). Die allgemeine Aufgabenstellung (Absenzkalender) wurde schon sehr sehr oft behandelt und wird i.d.R. mittels bedingter Formatierung gelöst.
cu
Chris

AW: Absenzenspiegel erstellen

10.10.2018 11:52:13

Richi

Ich möchte aus Tabelle 1 pro Name und Start / End-Datum (vertical), dies in Tabelle 2 unter dem entsprechenden Namen die Absenz als Range (jedes Feld von Startdatum bis Enddatum) mit einem x markieren und mit einer Farbe hinterlegen.
https://www.herber.de/bbs/user/124513.xlsx

AW: Absenzenspiegel erstellen

10.10.2018 16:09:29

ChrisL

=ZÄHLENWENNS(Tabelle1!$A:$A;$B10;Tabelle1!$C:$C;"="&C$9)

AW: Absenzenspiegel erstellen

10.10.2018 19:58:03

Dieter

Hallo Richi,
ich habe dir mal ein VBA-Programm geschrieben, welches die Übernahme durchführt.

Sub Abwesenheiten_übernehmen()
Dim aktMitarbeiter As String
Dim anfDatum As Date
Dim endDatum As Date
Dim letzteSpalteZ As Long
Dim letzteZeileQ As Long
Dim letzteZeileZ As Long
Dim maxDatum As Date
Dim minDatum As Date
Dim spalteZ As Long
Dim wb As Workbook
Dim wsQ As Worksheet ' Quelle (Tabelle1)
Dim wsZ As Worksheet ' Ziel (Tabelle2)
Dim zeileQ As Long
Dim zeileZ As Long
Set wb = ThisWorkbook
Set wsQ = wb.Worksheets("Tabelle1")
Set wsZ = wb.Worksheets("Tabelle2")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "B").End(xlUp).Row
letzteSpalteZ = wsZ.Cells(9, wsZ.Columns.Count).End(xlToLeft).Column
' Bisherige Farben und x-Werte löschen
If letzteZeileZ > 9 And letzteSpalteZ > 2 Then
With wsZ.Cells(10, "B").Resize(letzteZeileZ - 9, letzteSpalteZ - 1)
.Interior.Pattern = xlNone
.ClearContents
End With
End If
minDatum = wsZ.Range("C9")
maxDatum = wsZ.Cells(9, letzteSpalteZ)
letzteZeileQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row
zeileZ = 9
For zeileQ = 2 To letzteZeileQ
If wsQ.Cells(zeileQ, "A")  aktMitarbeiter Then
' Wechsel des Mitarbeiters
zeileZ = zeileZ + 1
aktMitarbeiter = wsQ.Cells(zeileQ, "A")
wsZ.Cells(zeileZ, "B") = aktMitarbeiter
End If
If Not IsEmpty(wsQ.Cells(zeileQ, "C")) And _
Not IsEmpty(wsQ.Cells(zeileQ, "D")) Then
anfDatum = wsQ.Cells(zeileQ, "C")
endDatum = wsQ.Cells(zeileQ, "D")
For spalteZ = 3 To letzteSpalteZ
If anfDatum

Du startest es durch Klick auf die Schaltfläche "Abwesenheiten übernehmen" im 2. Tabellenblatt.
https://www.herber.de/bbs/user/124552.xlsm
Viele Grüße
Dieter

AW: Absenzenspiegel erstellen

11.10.2018 21:55:23

Richi

Hallo Dieter
Absolut grossartig. Funktioniert einwandfrei. Bin Happy
Gruss Richi

AW: Absenzenspiegel erstellen

12.10.2018 05:51:25

Hajo_Zi

Hallo Dieter,
warum offen?

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.

AW: Absenzenspiegel erstellen

12.10.2018 09:20:00

Dieter

Hallo Hajo, hallo Richi,
@Hajo:
bei dem "noch offen" muss es sich um ein Versehen handeln. Ich weiss nicht, wie das zustande gekommen ist.
@Richi:
Ich habe versucht das Programm zu beschleunigen. Es ist mir aber nur gelungen, es etwa 10% schneller zu machen, ich hatte auf mehr gehofft.
Hier die neue Version:

Sub Abwesenheiten_übernehmen()
Dim aktMitarbeiter As String
Dim anfDatum As Date
Dim datum As Date
Dim dauer As Single
Dim endDatum As Date
Dim letzteSpalteZ As Long
Dim letzteZeileQ As Long
Dim letzteZeileZ As Long
Dim maxDatum As Date
Dim minDatum As Date
Dim spalteZ As Long
Dim wb As Workbook
Dim wsQ As Worksheet ' Quelle (Tabelle1)
Dim wsZ As Worksheet ' Ziel (Tabelle2)
Dim zeileQ As Long
Dim zeileZ As Long
dauer = Timer
Set wb = ThisWorkbook
Set wsQ = wb.Worksheets("Tabelle1")
Set wsZ = wb.Worksheets("Tabelle2")
letzteZeileZ = wsZ.Cells(wsZ.Rows.Count, "B").End(xlUp).Row
letzteSpalteZ = wsZ.Cells(9, wsZ.Columns.Count).End(xlToLeft).Column
' Bisherige Farben und x-Werte löschen
If letzteZeileZ > 9 And letzteSpalteZ > 2 Then
With wsZ.Cells(10, "B").Resize(letzteZeileZ - 9, letzteSpalteZ - 1)
.Interior.Pattern = xlNone
.ClearContents
End With
End If
minDatum = wsZ.Range("C9")
maxDatum = wsZ.Cells(9, letzteSpalteZ)
letzteZeileQ = wsQ.Cells(wsQ.Rows.Count, "A").End(xlUp).Row
zeileZ = 9
For zeileQ = 2 To letzteZeileQ
If wsQ.Cells(zeileQ, "A")  aktMitarbeiter Then
' Wechsel des Mitarbeiters
zeileZ = zeileZ + 1
aktMitarbeiter = wsQ.Cells(zeileQ, "A")
wsZ.Cells(zeileZ, "B") = aktMitarbeiter
End If
If Not IsEmpty(wsQ.Cells(zeileQ, "C")) And _
Not IsEmpty(wsQ.Cells(zeileQ, "D")) Then
anfDatum = WorksheetFunction.Max(wsQ.Cells(zeileQ, "C"), minDatum)
endDatum = WorksheetFunction.Min(wsQ.Cells(zeileQ, "D"), maxDatum)
If anfDatum

Viele Grüße
Dieter

Beliebteste Forumthreads (12 Monate)

Forumthread: Absenzenspiegel erstellen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread