HERBERS Excel-Forum - die Beispiele

Thema: Jahre, Monate und Tage von Zeiträumen ermitteln

Home

Gruppe

Funktion

Problem

Über die nicht dokumentierte DATEDIF-Funktion werden im Bereich D1:D3 die Jahre, Monate und Tage von Zeiträumen ermittelt.

Lösung
Formel zur Ermittlung der Jahre: =DATEDIF(A1;B1;"y")
StandardModule: basMain

Sub Main()
   Dim wks As Worksheet
   Dim cmt As Comment
   Dim vYear As Variant
   Dim iRow As Integer
   Dim bln As Boolean
   Application.ScreenUpdating = False
   bln = Application.DisplayStatusBar
   Application.DisplayStatusBar = True
   Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   Set wks = ActiveSheet
   vYear = InputBox( _
      prompt:="Gewünschtes Kalenderjahr angeben:", _
      Default:=Year(Date))
   Range("C1").Value = CInt(vYear)
   Workbooks.Add 1
   Call MonateAnlegen
   Call TageEintragen
   iRow = 1
   Do Until IsEmpty(wks.Cells(iRow, 1))
      With Worksheets(Month(wks.Cells(iRow, 2).Value))
         With .Cells(Day(wks.Cells(iRow, 2).Value), 1)
            .Interior.ColorIndex = 36
            Set cmt = .AddComment(wks.Cells(iRow, 1).Value)
            cmt.Shape.TextFrame.AutoSize = True
         End With
      End With
      iRow = iRow + 1
   Loop
   Application.DisplayStatusBar = bln
   Application.StatusBar = False
   Application.ScreenUpdating = True
End Sub

Private Sub MonateAnlegen()
   Dim iMonth As Integer
   For iMonth = 1 To 12
      If iMonth > 1 Then
         Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
      End If
      ActiveSheet.Name = Format( _
         DateSerial(Range("C1").Value, iMonth, 1), "mmmm")
   Next iMonth
End Sub

Private Sub TageEintragen()
   Dim wks As Worksheet, wksMy As Worksheet
   Dim lDay As Long
   Dim iMonth As Integer, iDay As Integer
   Set wksMy = ThisWorkbook.Worksheets("Feiertage")
   For iMonth = 1 To 12
      Set wks = Worksheets(iMonth)
      Application.StatusBar = "Bearbeite Monat " & wks.Name
      wks.Columns(1).NumberFormat = "dd.mm.yy"
      wks.Columns(2).NumberFormat = "dddd"
      For lDay = DateSerial(wksMy.Range("C1").Value, iMonth, 1) To _
         DateSerial(wksMy.Range("C1").Value, iMonth + 1, 0)
         iDay = iDay + 1
         wks.Cells(iDay, 1) = lDay
         wks.Cells(iDay, 2) = lDay
         If WeekDay(lDay) = 7 Then
            wks.Cells(iDay, 1).Interior.ColorIndex = 34
            wks.Cells(iDay, 2).Interior.ColorIndex = 34
         ElseIf WeekDay(lDay) = 1 Then
            wks.Cells(iDay, 1).Interior.ColorIndex = 35
            wks.Cells(iDay, 2).Interior.ColorIndex = 35
         End If
      Next lDay
      iDay = 0
    Next iMonth
    Worksheets(1).Select
    ActiveWindow.Caption = "Jahreskalender " & wksMy.Range("C1").Value
End Sub

StandardModule: basFunction

Function Ostern(iYear As Integer)
   Dim iDay As Integer
   iDay = (((255 - 11 * (iYear Mod 19)) - 21) Mod 30) + 21
   Ostern = DateSerial(iYear, 3, 1) + iDay + (iDay > 48) + _
      6 - ((iYear + iYear \ 4 + iDay + (iDay > 48) + 1) Mod 7)
End Function

Beiträge aus dem Excel-Forum zu den Themen Funktion und DATEDIF

Copy funktioniert nur einmal Schreibschutz prüfen funktioniert nicht
Split-Funktion beim Einlesen TXT-Datei Match Funktion spinnt (?)
SVerweis funktioniert nicht PasteSpecial funktioniert nicht.
VBA-Code funktioniert nicht mit anderem Office Hilfe bei der INDEX Funktion
Zelladressen von FunktionsParametern ermitteln Matrixformel mit Summenfunktion
Formel funktioniert nicht, SVerweis Makro funktioniert nach Beenden von Excel nicht
VLOOKUP auf Links funktioniert offline @DAVID Zwei SUMMEWENN funktionen verknüpfen
Zwei SUMMEWENN funktionen verknüpfen Polynomfunktion
Mit vba Funktionen in Excel Zellen Rang-Funktion für Strings?
Skript funktioniert nur auf einer seite?!?! Hyperlink auf Excel-Datei funktioniert nicht
Public Funktion / Variabel VBA - Suchfunktion - Fehlermeldung
Benutzerdefinierte Funktion Userform mit Löschfunktion
Frage zu Wenn Dann Funktion Wenn-Funktion
Frage zur Funktion DISAGIO Funktion um Chart zu kreieren
Wenn-Funktion verschachtelt VBA Suchfunktion erweitern
Makro funktioniert nicht richtig zählenwenn-funktion mit mehreren kriterien
Funktion SVERWEIS Benutzerdefinierte Funktion in Open Office
Funktion Dezimal -> Zeit/ Variablen-Deklaration Probleme mit Textfunktionen
Fehler, wenn Variable in Funktion VBA-Funktion analog =ZELLE("Zeile")
Gültigkeit funktioniert nicht! Zellausrichtung funktioniert nicht
WENN-Funktion Hide-Funktion in einem Frame
Suchfunktion Date Funktion
Filter funktioniert nicht Funktionsname austauschen
Datum in der Funktion VERWEIS Sub oder Funktion nicht definiert in kleinem Makro
Funktion in einer anderen Datei aufrufen