Vba Excel Ulraub Zeile Anfangs und Enddatum ermitteln
#1
Ich habe im internet ein vba code gefunden was eigentlich schon gut funktioniert, mir fehlen noch paar Erweiterungen

der script  ermittelt anfangs und enddatum von ein U drin steht soweit so gut.
zb.
                 01.01          02.01.          03.01.       04.01          05.01         06.01          07.01         08.01          09.01          10.01        11.01        12.01       13.01      14.01         15.01        16.01
                   MO              DI                MI            DO              FR             SA              SO            MO              Di                Mi            DO             FR          SA          SO             MO           DI
Mustermann                     U                 U              U                U               X                X              U                U                 U              U                             X            X

Aktuell sieht die Ausgabe so aus 

Musterman   02.01.    05.01      08.01       11.01

ich möchte das es die Wochenenden mit berücksichtigt das wenn der Folgende Montag ein U hat soll es die X wie U behandeln 
Musterman   02.01    11.01

zusätzlich alle abgelaufen datum sollen gelöscht werden ist es möglich den code so Umzuschreiben ???

Code:
Sub Urlaubszusammenfassung()
Quelle = "Tabelle1" 'Name der Quelltabelle
AbZeileQ = 1 'Zeile, in welcher die Datumswerte stehen
AbSpalteQ = 1 'Spalte, in welcher die Mitarbeiternamen stehen
Ziel = "Tabelle2" 'Name der Zieltabelle
AbZeileZ = 1 'Zeile, ab welcher die Ergebnisdaten eingetragen werden sollen
AbSpalteZ = 1 'Spalte, ab welcher die Ergebnisdaten eingetragen werden sollen
Kennz = "U" 'Kennzeichen, nach welchem gesucht werden soll

ZeileQ = AbZeileQ + 1 'Beginne in Quelltabelle in der Zeile mit erstem Mitarbeiter
ZeileZ = AbZeileZ 'Beginne in der Zieltabelle in der ersten Ergebniszeile
MA = Worksheets(Quelle).Cells(ZeileQ, AbSpalteQ).Value 'Mitarbeiternamen lesen
Do While MA <> "" 'Solange ein Mitarbeitername gefunden wird, Schleife durchführen
    SpalteQ = AbSpalteQ + 1 'Beginne in der Quelltabelle in der Spalte mit dem ersten Datumswert
    SpalteZ = AbSpalteZ + 1 'Beginne in der Zieltabelle in der Spalte nach dem Mitarbeiternamen
    Beginn = "" 'Beginndatum des Urlaubszeitraumes löschen
    Worksheets(Ziel).Cells(ZeileZ, AbSpalteZ).Value = MA 'Mitarbeiternamen in vorgegebene Spalte der Zieltabelle übertragen
    Dat = Worksheets(Quelle).Cells(AbZeileQ, SpalteQ).Value ' Datumswert aulsesen
    Do While Dat <> "" 'Solange es noch Datumswerte gibt, Schleife wiederholen
        If Worksheets(Quelle).Cells(ZeileQ, SpalteQ).Value = Kennz Then ' Wenn das Kennzeichen in der Zeile des MA gefunden wird ...
            If Beginn = "" Then '... und nicht bereits ein Urlaubsbeginn voerher erkannt wurde ...
                Worksheets(Ziel).Cells(ZeileZ, SpalteZ).Value = Dat ' ... Urlaubsbeginn in Zieltabelle eintragen und ...
                Beginn = Dat ' ... Beginndatum zwischenspeichern
                SpalteZ = SpalteZ + 1 'nächster Eintrag in Zieltabelle erfolgt in nächster Spalte
            End If
        Else ' kein Urlaubstag
            If Beginn <> "" Then ' Wenn laufender Urlaub ...
                Ende = Worksheets(Quelle).Cells(AbZeileQ, SpalteQ - 1).Value ' ... als Enddatum den gestrigen Tag festlegen
                If Beginn <> Ende Then ' Wenn Beginn und Ende unterschiedlich (mehrtätiger Urlaub) ...
                    Worksheets(Ziel).Cells(ZeileZ, SpalteZ).Value = Ende ' ... Enddatum eintragen
                    'SpalteZ = SpalteZ + 1 'nächster Eintrag in Zieltabelle erfolgt in nächster Spalte
                End If
                Beginn = "" 'Beginndatum des Urlaubszeitraumes löschen
                SpalteZ = SpalteZ + 2 'nächster Eintrag in Zieltabelle erfolgt in übernächster Spalte - dadurch leere Zelle(n) nach Urlaub
            End If
        End If
        SpalteQ = SpalteQ + 1 'nächsten Tag des Jahres betrachten ...
        Dat = Worksheets(Quelle).Cells(AbZeileQ, SpalteQ).Value '... und dessen Datumswert zwischenspeichern
    Loop 'alle Datumswerte (des Jahres) durch
    ZeileQ = ZeileQ + 1 'nächste Zeile für Mitarbeiter in Quelltabelle
    ZeileZ = ZeileZ + 1 'nächste Zeile für Mitarbeiter in Quelltabelle
    MA = Worksheets(Quelle).Cells(ZeileQ, AbSpalteQ).Value'Mitarbeiternamen lesen
Loop 'alle Mitarbeiter durch
MsgBox "Fertig."
End Sub

Mfg
Antworten Top
#2
Hallöchen,

probiere mal statt

If Worksheets(Quelle).Cells(ZeileQ, SpalteQ).Value = Kennz

dann

If Worksheets(Quelle).Cells(ZeileQ, SpalteQ).Value = Kennz Or Worksheets(Quelle).Cells(ZeileQ, SpalteQ).Value = "X"
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • exitus
Antworten Top
#3
Hallo,

danke es hat geklappt du bist Prima wenn ich noch was habe kann ich mich doch melden?

wie bekomme ich es hin nur die U zu zählen und direkt neben der zell ausgeben??  ohne die X die U zählen
Antworten Top
#4
Hallöchen,

Du könntest die beiden Daten, die zu einem Urlaub gehören, in der Funktion NETTOARBEITSTAGE verwenden. Du musst nur noch irgendwo die Feiertage hinterlegen ...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste