Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Freie Tage in Kalender eintragen

Freie Tage in Kalender eintragen
16.01.2018 17:34:18
Johann
Hallo Liebe Forumgemeinde,
Kann mir jemand für dieses Problem weiterhelfen?
Ich habe im Sheet "Daten" Namen stehen.
Einige davon haben in Gerader KW z.b. Di und Do frei
und in der ungeraden KW Mo, Mi und Fr frei.
Bild 1 vom Sheet mit den Daten
Bild 2 vom Sheet Januar
Es soll zu jedem Namen wenn im Sheet "Daten" was hinterlegt ist
in den Sheets Januar bis Dezember in bestimmter KW und Wochentag
ein "X" hinterlegt werden.
Bild1:
Userbild
Bild2:
Userbild

16
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Freie Tage in Kalender eintragen
16.01.2018 17:57:40
Johann
Ich habe gemerkt, dass ich im Sheet Januar
die Falschen Tage markiert.
Die erste Woche ist ja KW 1 und es sollten
Mo Mi und Fr markiert sein.
Genau deswegen bräuchte ich auch diesen code:)
Ich weiß es ist nicht leicht und kann deshalb
die Datei per Mail zuschicken.
Dafür geb ich auch etwas per PayPal her ;)
AW: Freie Tage in Kalender eintragen
16.01.2018 17:58:43
Hajo_Zi
Du hast ja ein Programm um aus einem Bild eine Tabelle zu machen. Darum Bilder in Deinem Beitrag.
Löse es so.
Userbild

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung....."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.
Anzeige
AW: Freie Tage in Kalender eintragen
16.01.2018 18:42:23
Johann
Hallo Hajo_Zi
ich verstehe leider nicht was du meinst.
Keine Bilder-Datei hier hochladen ! owT
16.01.2018 18:54:05
robert
Keine Bilder-Datei hier hochladen ! owT
16.01.2018 18:54:06
robert
AW: Keine Bilder-Datei hier hochladen ! owT
16.01.2018 19:00:11
Johann
Tut mir leid.
Ich dachte so währe es verständlicher.
Sorry
AW: gemeint ist ...
16.01.2018 19:16:38
...
Hallo Johann,
... anstelle Deine Bilder ist eine entsprechende Excelarbeitsmappe sinnvoller, wenn Du Hilfe erwartest.
Gruß Werner
.. , - ...
AW: gemeint ist ...
16.01.2018 19:38:18
Johann
Ich habe ein Muster von der Datei erstellt
bei welcher nur noch Januar und Daten drauf sind wegen der größe.
https://www.herber.de/bbs/user/119025.xlsm
Hoffe ihr könnt mir helfen dabei.
Vielen Dank für eure mühe.
AW: nachgefragt ...
16.01.2018 19:56:50
...
Hallo Johann,
... was für eine Art Lösung suchst Du? Solltest Du eine VBA-Lösung bin ich außen vor. Wenn Du jedoch keine VBA-Lösung suchst, dann steht die Frage warum Du eine xlsM-Datei einstellst?
Gruß Werner
.. , - ...
Anzeige
AW: VBA da Datenmenge zu groß
16.01.2018 20:08:40
Johann
Hallo Werner,
die daten sollten per VBA gelesen und auf die Monate übertragen werden.
Danke trotzdem
AW: gemeint ist ...
16.01.2018 20:32:26
Sepp
Hallo Johann,
ich denke mal, du suchst eine VBA-Lösung.
Ich habe deine Feiertags-Lösung isoliert, damit man sie flexibler einsetzen kann.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub mitarbeiterTage()
Dim lngMonth As Long, lngLast As Long, lngRow As Long, lngCol As Long, lngLastCol As Long
Dim varTemp As Variant, varColor As Variant, varRet As Variant, lngWeek As Long, lngDay As Long
Dim objData As Worksheet

Set objData = Worksheets("Daten")

For lngMonth = 1 To 1 '2
  With Sheets(Format(DateSerial(objData.Range("S3"), lngMonth, 1), "MMMM"))
    lngLast = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)
    lngLastCol = 4 + Day(DateSerial(objData.Range("S3"), lngMonth + 1, 0))
    varTemp = .Range(.Cells(1, 3), .Cells(lngLast, lngLastCol))
    varColor = .Range(.Cells(1, 3), .Cells(1, lngLastCol)).Interior.Color
    For lngRow = 2 To UBound(varTemp, 1)
      varRet = Application.Match(varTemp(lngRow, 1), objData.Columns(3), 0)
      If IsNumeric(varRet) Then
        For lngCol = 3 To UBound(varTemp, 2)
          If isHolyday(varTemp(1, lngCol)) = "" Then
            lngDay = Weekday(varTemp(1, lngCol), vbMonday)
            lngWeek = (DINKwoche(varTemp(1, lngCol)) Mod 2 = 0) * -5
            If objData.Cells(varRet, 4 + lngDay + lngWeek) = "x" Then
              varTemp(lngRow, lngCol) = "x"
            End If
          End If
        Next
      End If
    Next
    .Range(.Cells(1, 3), .Cells(lngLast, lngLastCol)) = varTemp
  End With
Next

Set objData = Nothing
End Sub

Private Function DINKwoche(ByVal Datum As Date) As Long
Dim tmp As Date
tmp = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
DINKwoche = (Fix(Datum - tmp - 3 + (Weekday(tmp) + 1) Mod 7) \ 7) + 1
End Function

Public Function isHolyday(ByVal datDate As Date) As String
Select Case datDate
  Case DateSerial(Year(datDate), 1, 1): isHolyday = "Neujahr"
  Case DateSerial(Year(datDate), 1, 6): isHolyday = "Hl. drei Könige"
  Case Ostern(Year(datDate)) - 2: isHolyday = "Karfreitag"
  Case Ostern(Year(datDate)): isHolyday = "Ostersonntag"
  Case Ostern(Year(datDate)) + 1: isHolyday = "Ostermontag"
  Case Ostern(Year(datDate)) + 39: isHolyday = "Christi Himmelfahrt"
  Case Ostern(Year(datDate)) + 49: isHolyday = "Pfingstsonntag"
  Case Ostern(Year(datDate)) + 50: isHolyday = "Pfingstmontag"
  Case Ostern(Year(datDate)) + 60: isHolyday = "Fronleichnam"
  Case DateSerial(Year(datDate), 8, 15): isHolyday = "Maria Himmelfahrt"
  Case DateSerial(Year(datDate), 10, 3): isHolyday = "datdate der D. Einheit"
  Case DateSerial(Year(datDate), 11, 1): isHolyday = "Allerheiligen"
  Case DateSerial(Year(datDate), 12, 24): isHolyday = "Heiliger Abend"
  Case DateSerial(Year(datDate), 12, 25): isHolyday = "1. Weihnachtstag"
  Case DateSerial(Year(datDate), 12, 26): isHolyday = "2. Weihnachtstag"
  Case DateSerial(Year(datDate), 12, 31): isHolyday = "Sylvester"
  Case Else: isHolyday = ""
End Select
End Function

https://www.herber.de/bbs/user/119026.xlsm
Gruß Sepp

Anzeige
und noch etwas...
16.01.2018 20:40:35
Sepp
... bei 'For lngMonth = 1 to 1 '2 musst du natürlich das Hochkomma rausnehmen.
Und varColor kannst du beide Male rausnehmen (deklaration und die Zeile mit der Zuweisung), das war ein 'Irrläufer' ;-)
Gruß Sepp

AW: und noch etwas...
16.01.2018 21:10:05
Johann
Es klappt fast ganz gut! Klasse Arbeit.
Darf ich dir die Komplette Datei schicken?
Dann siehst du gleich was ich meine.
klar darfst du! o.T.
16.01.2018 21:10:58
Sepp
Gruß Sepp

Anzeige
AW: klar darfst du! o.T.
16.01.2018 21:18:42
Johann
Kannst du mir ne Mailadresse geben?
Da die datei 7MB hat
du hast Post! o.T.
16.01.2018 21:30:17
Sepp
Gruß Sepp

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige