Makro für

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro für

03.07.2023 20:48:58

Piet

AW: Makro für

04.07.2023 07:21:54

Christian

AW: Makro für

04.07.2023 13:34:45

Yal

AW: Makro für

04.07.2023 14:49:52

Christian

AW: Makro für

05.07.2023 15:03:36

Yal

Hallo Yal,
die HU-641 ist ein Kurzzeichen bzw. Abteilung, welche verschiedene Projekte betreibt. Alle Mitarbeiter die in der Liste stehen, sind zwar in verschiedenen Projekten, doch in der selben Abteilung. Natürlich gibt es hier auch andere Abteilungen. Für das Beispiel habe ich jedoch nur diese drin. Die Abfrage bzgl. Abteilung ist deswegen relevant, weil ich nur die Mitarbeiter da einsetzten will, die schon in der Abteilung tätig waren/sind)

Ich hoffe das Bild macht es etwas deutlicher.
Userbild

Wenn ich ein neues Projekt habe und ich noch einen MA suche, soll das Makro folgende Schritte durchgehen:
01. Ich markiere eine Zeile wo ich noch keinen MA hab, dann betätige ich einen Button
02. Der Zeitraum für das Projekt aus ausgewählter Zeile (Q-R) wird gesucht
03. Abgleich mit Abteilung (L) - also nur die MA die schon in der Liste bei dieser Abteilung sind/waren werden herangezogen
04. Sobald ein MA im gesuchten Zeitraum Zeit hätte, also keine Überschneidung von Datum, sollen die MA-Nummern (Spalte G) gelb markiert werden.
05. Dann kann man den MA zB für einen weiteren Zeitraum einteilen

Hallo Christian,

Bei der Frage nach einer vollständigen Lösung mache ich meistens einen Bogen, aber in dem Fall hat mir die Fragestellung gekitzelt: kein ganz einfache Frage. Oder doch?

Folgende Lösung:

Public Sub Mitarbeiter_finden()
Dim Z
Dim Abt As String
Dim Start As Date
Dim Ende As Date
Dim dic As Object
Dim Elt
Dim Frei As Boolean
    
    If ActiveSheet.Name > Me.Name Then Exit Sub 'nur aktion, wenn auf "Aufträge"
            
    Abt = ActiveCell.EntireRow.Range("L1") 'relative Adresse: die betrachtete Zeile ist immer die 1
    If Abt = "" Then Exit Sub 'wenn die Zeile keine Abteilung enthält, einfach aussteigen
    
    Start = CDate(ActiveCell.EntireRow.Range("Q1").Value)
    Ende = CDate(ActiveCell.EntireRow.Range("R1").Value)
    With Range(Range("L8"), Cells(Rows.Count, "L").End(xlUp))
        .Offset(, -5).Interior.Pattern = xlNone  'Reset alle Farbmarkierung
    'Information über die MA der Abt sammeln
        Set dic = CreateObject("Scripting.Dictionary")
        For Each Z In .EntireRow ' Z ist hier eine Zeile. A1 ist die Zelle in erste Spalte davon
            If Z.Range("L1").Value = Abt And Z.Range("G1").Value > "" Then
                dic(Z.Range("G1").Value) = dic(Z.Range("G1").Value) & ";" & Z.Range("Q1").Value & "-" & Z.Range("R1").Value
            End If
        Next
    End With
'Verfügbarkeit pro Mitarbeiter prüfen
    For Each Elt In dic.keys
        Frei = True
        For Each Z In Split(Mid(dic(Elt), 2), ";")
            Frei = Frei And (Start > CDate(Split(Z, "-")(1)) Or Ende  CDate(Split(Z, "-")(0)))
        Next
        If Frei Then SucheUndMarkiere Elt
    Next
End Sub

Private Sub SucheUndMarkiere(ByVal MitarbeiterCode As String)
Dim Z As Range
    For Each Z In Range(Me.Range("G8"), Me.Cells(Rows.Count, "G").End(xlUp))
        If Z.Value = MitarbeiterCode Then
            With Z.Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936
                If Z.Value = MitarbeiterCode Then .Pattern = xlSolid
            End With
        End If
    Next
End Sub

Die für die betrachtenen Phase freie Mitarbeiter werden grün markiert.
Du kannst eins Schaltfläche einbauen und das Makro zuweisen, Du kannst aber auch Alt+F8 (Makroauswahl) und weil keine andere Makro vorhanden ist, sofort Enter drücken.
Deine Beispieldatei ist auch nicht besonders hilfreich. Ich habe eine gekürzte Version gebaut.
https://www.herber.de/bbs/user/159809.xlsm

VG
Yal

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread