Tabellenblatt kopieren mit weiterer Datumsfunktion

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Stefan
Geschrieben am: 18.10.2015 15:28:16

Hallo!
Ich habe bereits einen Beitrag geschrieben, aber auf diesen kann ich leider nicht mehr antworten siehe Link darunter und ich hoffe es kann mir die Funktion jemand noch weiter anpassen.
https://www.herber.de/forum/archiv/1448to1452/t1451803.htm
Das Problem ist das es von Sepp schon perfekt für das Jahr 2015 funktioniert aber nicht für das Jahr 2016.
Ich möchte das mir das Tabellenblatt mit meiner Vorlage das KW heißt (KW = Kalenderwoche) steht die KW aufs Jahr hochrechnet, und automatisch das Datum einfügt.
Das heißt es muss KW1 - KW52 geben und in den Zellen B3:F3 soll immer das jeweilige Datum von Mo - Fr stehen.
2015 funktioniert es mit dem darunter liegenden Skript super, nur 2016 ist eine Kalenderwoche zuviel und der Beginn ist falsch.
Das heißt für das Jahr 2016 würde KW1 mit dem Datum 04.01.16 - 08.01.16 beginnen, bei dem Script startet es aber schon mit 28.12.15 - 01.01.16 und es gibt KW53 statt KW52.
Ich hoffe es kann mir das jemand noch ein wenig anpassen. Den meine Kenntnisse reichen dafür leider nicht aus.
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub BlaetterAnlegen()
Dim varYear As Variant, lngWeek As Long, lngDay As Long
Dim datWeek As Date
varYear = Application.InputBox("Bitte gewünschtes Jahr eingeben:", "Blätter anlegen", CStr(Year(Date)), Type:=2)
If Not varYear = False Then
For lngWeek = 1 To 53
datWeek = DateFromKW(varYear, lngWeek)
If Year(datWeek) = Clng(varYear) Or Year(datWeek + 4) = Clng(varYear) Then
Sheets(1).Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = "KW" & lngWeek
.Range("G1") = .Name
For lngDay = 0 To 4
'B3:F3
.Cells(3, 2 + lngDay) = datWeek + lngDay
Next
End With
End If
Next
End If
End Sub

Private Function DateFromKW(ByVal Year As Integer, ByVal KW As Integer) As Date
DateFromKW = DateSerial(Year, 1, 7 * KW - 3 - Weekday(DateSerial(Year, 1, 1), 7))
End Function

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Luschi
Geschrieben am: 19.10.2015 07:33:21
Hallo Stefan,
bei mir sieht das so aus:


Sub BlaetterAnlegen()
Dim varYear As Variant, lngWeek As Long, lngDay As Long
Dim datMon As Date
varYear = Application.InputBox("Bitte gewünschtes Jahr eingeben:", "Blätter anlegen", CStr(Year( _
Date)), Type:=2)
If Not varYear = False Then
   For lngWeek = 1 To letzteKWimJahr(CInt(varYear))
       datMon = fctKWMon(lngWeek, CLng(varYear))
       Sheets(1).Copy After:=Sheets(Sheets.Count)
       With ActiveSheet
          .Name = "KW" & lngWeek
          .Range("G1") = .Name
          For lngDay = 0 To 4
              'B3:F3
              .Cells(3, 2 + lngDay) = datMon + lngDay
          Next lngDay
       End With
   Next
End If
End Sub
Function letzteKWimJahr(xJahr As Integer)
    Dim d As Date
    
    d = DateSerial(xJahr, 12, 31)
    letzteKWimJahr = (d - DateSerial(Year(d - ((d - 2) Mod 7) + 3), 1, (d - 2) Mod 7 - 9)) \ 7
End Function
'http://www.donkarl.com?FAQ2.9
Public Function fctKWMon(ArgKW As Long, Optional ArgJahr As Long)
  'gibt den Montag der übergebenen Kalenderwoche zurück
    Dim M As Date
    If IsMissing(ArgJahr) Then ArgJahr = Year(Date)
    M = DateSerial(ArgJahr, 1, 1) + (ArgKW - 1) * 7
    M = M + 1 - Weekday(M, vbMonday)
    If Format(M, "ww", vbMonday, vbFirstFourDays) <> ArgKW Then M = M + 7
    If (ArgKW = 1 Or ArgKW = 53) And Day(M) > 4 And Day(M) < 8 Then M = M - 7
    fctKWMon = M
End Function
Gruß von Luschi
aus klein-Paris

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Stefan
Geschrieben am: 19.10.2015 22:54:02
Hallo Luschi!
Vielen Dank, jetzt funktioniert es perfekt.
Jetzt würde ich gern noch eine weitere Funktion einbauen, aber ich weiß nicht ob das überhaupt möglich ist.
Ich habe noch eine weitere Tabelle die Urlaub 2016.xlsm heißt. In dieser sind die Urlaubsdaten der Mitarbeiter eingetragen. Und jedes Tabellenblatt heißt nach dem jeweiligen Mitarbeiter.
Also zb. Mitarbeiter1, Mitarbeiter2 usw.
Jetzt würde ich gern diese 2 Tabellen miteinander verbinden. In der Tabelle Urlaub 2016 stehen in A11:B26 die Urlausdaten wie zb. 14.01.16 bis 20.01.16 usw.
In der Tabelle KW stehen in den Zellen A4:A28 die Namen der Mitarbeiter.
Jetzt soll er mir automatisch bei meiner KW Tabelle, wenn der Mitarbeiter während der Zeit im Urlaub ist, ein "U" in die jeweilige Zelle zum richtigen Datum schreiben.
Die Zellen dazu sind B4:G28
Das heißt er soll in der Tabelle Urlaub 2016, das Datum des Urlaubes mit den Buchstaben "U" in die jeweilige Zelle in die Tabelle mit den KW1 - KW52 zu den richtigen Mitarbeiter schreiben.
Ich hoffe ich konnte es verständlich schreiben. Danke

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Stefan
Geschrieben am: 20.10.2015 19:58:54
Hat keiner irgendeine Idee?
Das müsste man ja vielleicht irgendwie mit der Index oder Sverweis Funktion hinbekommen??
Oder habe ich es schlecht beschrieben bzw. erklärt? Dann kann ich auch die Tabellen hochladen.

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Luschi
Geschrieben am: 22.10.2015 06:12:29
Hallo Stefan,
mit Vba ist vieles möglich und sich auch Dein amliegen.
Aber ich habe es mir abgewöhnt, aus Userangaben, die nur verbal das Problem beschreiben
die Exceltabellen/.mappen selbst aufzubauen. Wenn Du echte Demodateien bereitstellst mit
-daten darin, dann schaue ich es mir an.
Gruß von Luschi
aus klein-Oaris

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Stefan
Geschrieben am: 22.10.2015 23:31:16
Hallo Luschi!
Ja da hast du auch Recht ist sicher einfacher mit einer Vorlage.
Ich lade dir die Daten mal rauf, ich hoffe du kannst mir helfen.
Es sollen auf jeden Fall die Urlaubsdaten verglichen werden und sollte der Mitarbeiter Urlaub haben ein "U" für Urlaub in der Tabelle KW bei dem richtigen Mitarbeiter und Datum stehen.
So hier die links mit meiner Vorlage
https://www.herber.de/bbs/user/100983.xlsm
https://www.herber.de/bbs/user/100985.xlsm

Bild

Betrifft: AW: Tabellenblatt kopieren mit weiterer Datumsfunktion
von: Luschi
Geschrieben am: 24.10.2015 14:00:36
Hallo Stefan,
hier mal mein 1. Versuch. Entpacke die zip-datei und starte 'GS_Urlaub.xlsm'.
Im Tabellenblatt 'Makro' findest Du den Startbutton.
Die 2. Datei 'MA_Urlaub-xlsm' wird von Makro dazugladen.
Für 'Mitarbeiter 2' habe ich die Urlaubsdaten verändert, um ein bischen zu testen.
https://www.herber.de/bbs/user/101014.zip
Gruß von Luschi
aus klein-Paris


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblatt kopieren mit weiterer Datumsfunktion"