Excel: Datum per Formel/VBA berechnen

Dieses Thema Excel: Datum per Formel/VBA berechnen im Forum "Microsoft Office Suite" wurde erstellt von oerlein, 20. Okt. 2005.

Thema: Excel: Datum per Formel/VBA berechnen Hi Leutz, ich hab ein kleines Excel-Problem. In einem Arbeitsblatt soll zuerst ein beliebiges Datum (z.B....

  1. Hi Leutz,

    ich hab ein kleines Excel-Problem.
    In einem Arbeitsblatt soll zuerst ein beliebiges Datum (z.B. 20.10.2005) eingegeben werden. In der nächsten Zeile soll dann der nächste Quartalsultimo erscheinen. In der übernächsten Zeile dann der nächste Quartalsultimo. Und so weiter....

    Ich hab bis jetzt ein VBA-Modul mit folgendem Inhalt geschrieben:

    ActiveCell() = DateAdd(m, 6, ActiveCells.Row -1, 1)

    Also wird im aktuellen Feld ein halbes Jahr zu dem Feld eine Zeile höher dazu gerechnet.
    Soweit so gut, aber wie kann ich ihm sagen, dass er beim 20.10.2005 den 31.12.2005 schreiben soll?

    Weiter schreibt er mir sechs Monate nach dem 30.06.2006 den 30.12.2006. Wie kann ich hier den 31.12.2006 anzeigen lassen? Kann ich in der Funktion mit Monaten und Tagen kombinieren?


    Danke schonmal für eure Tipps! :)
     
  2. Ein echter Blockbuster.
    Editierte Version 23.10.2005 20:05:
    Code:
    Sub Ultimo_drunter()
    ActiveCell.Offset(1, 0).Select
      ActiveCell.FormulaR1C1 = _
        =IF(OR(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)),R[-1]C=DATE(YEAR(R[-1]C),12,31)),DATE(YEAR(R[-1]C)+1,3,31), & _
        IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)),R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)),R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)),R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31),))))
    'Selection.Copy
    'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
    
    ActiveCell.Offset(1, 0).Select
      ActiveCell.FormulaR1C1 = _
        =IF(OR(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)),R[-1]C=DATE(YEAR(R[-1]C),12,31)),DATE(YEAR(R[-1]C)+1,3,31), & _
        IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)),R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)),R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)),R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31),))))
        Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
    
    ActiveCell.Offset(1, 0).Select
      ActiveCell.FormulaR1C1 = _
        =IF(OR(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)),R[-1]C=DATE(YEAR(R[-1]C),12,31)),DATE(YEAR(R[-1]C)+1,3,31), & _
        IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)),R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)),R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)),R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31),))))
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
    
    ActiveCell.Offset(1, 0).Select
      ActiveCell.FormulaR1C1 = _
        =IF(OR(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)),R[-1]C=DATE(YEAR(R[-1]C),12,31)),DATE(YEAR(R[-1]C)+1,3,31), & _
        IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)),R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)),R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & _
        IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)),R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31),))))
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
    End Sub
    Zelle mit dem Anfangsdatum markieren und dann das Makro laufen lassen.
    Es erzeugt in den nächsten 4 Zellen die gewünschten Ultimi.
    Falls du mehr Zellen haben willst, mußt du weitere Module (ActiveCell.Offset(1, 0).Select ...... Application.CutCopyMode = False) anfügen.

    [edit 23.10.2005 20:05]
    Ich habe jetzt meine Zeilen umgebrochen. Ich wußte, daß da irgendwas mit dem Unterstrich ist, aber das kaufmännische UND hatte ich nicht parat, so daß es beim Umbruch immer Fehlermeldungen gab.
    Und den Jahreswechsel ist jetzt auch wieder drin. Er ist beim Umrechnen der Formel in die Makro-Sprache verlorengegangen.
     
  3. Hallo zusammen,

    @klexy:
    der Zeilenumbruch muß in den Code eingebaut werden, sonst würde der Empfänger die Zeilenumbrüche mitkopieren, was im VBA übel nehmen würde.

    Der Code mit Umbrüchen könnte dann so aussehen:
    Code:
    Sub Ultimo_drunter2()
    
      Const c_ANZAHLZELLEN = 4
      Const c_FORMELNAECHSTERULTIMO As String = _
              =IF(OR(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)), & _
                R[-1]C=DATE(YEAR(R[-1]C),12,31)),DATE(YEAR(R[-1]C),3,31), & _
              IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)), & _
                  R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & _
              IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)), & _
                R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & _
              IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)), & _
                R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31),))))
    
      Dim x As Long
    
      If Selection.Count > 1 Then
        MsgBox (Bitte nur eine Zelle mit Datum markieren.)
        Exit Sub
      End If
      
      If Not IsDate(ActiveCell.Value) Then
        MsgBox (markierte Zelle enthält kein gültiges Datum.)
        Exit Sub
      End If
    
      For x = 1 To c_ANZAHLZELLEN
       ->Format der Selektierten Zelle übertragen
        ActiveCell.Offset(1, 0).NumberFormat = ActiveCell.NumberFormat
       ->Formel eintragen
        ActiveCell.Offset(1, 0).FormulaR1C1 = c_FORMELNAECHSTERULTIMO
       ->Formelergebnis zu Wert
        ActiveCell.Offset(1, 0).Copy
        ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlValues
      Next
      Application.CutCopyMode = False
    End Sub
    Beim Jahresumbruch macht die Funktion leider noch einen Fehler  :(

    Die folgende Version berücksichtigt auch den Jahresumbruch.

    Mit der Konstanten c_ANZAHLZELLEN kann bestimmt werden, wieviel weiter Ultimos ausgefüllt werden (im Augenblick 4)

    Gruß Matjes :)

    Code:
    Sub Ultimo_drunter3()
    
      Const c_ANZAHLZELLEN = 4
      
      Dim x As Long, d_date As Date, s_date As String
      Dim l_year As Long, l_month As Long, l_day As Long
    
      If Selection.Count > 1 Then
        MsgBox (Bitte nur eine Zelle mit Datum markieren.)
        Exit Sub
      End If
      
      If Not IsDate(ActiveCell.Value) Then
        MsgBox (markierte Zelle enthält kein gültiges Datum.)
        Exit Sub
      End If
    
      For x = 1 To c_ANZAHLZELLEN
    
       ->Format der Selektierten Zelle übertragen
        ActiveCell.Offset(1, 0).NumberFormat = ActiveCell.NumberFormat
        
       ->Datum holen
        d_date = ActiveCell.Value
        l_year = Year(d_date)
        l_month = Month(d_date)
        l_day = Day(d_date)
        
       ->Auf Ultimo prüfen
        If l_month <= 3 Then
          If l_month = 3 And l_day = 31 Then l_month = 6: l_day = 30 Else l_month = 3: l_day = 31
        ElseIf l_month <= 6 Then
          If l_month = 6 And l_day = 30 Then l_month = 9: l_day = 30 Else l_month = 6: l_day = 30
        ElseIf l_month <= 9 Then
          If l_month = 9 And l_day = 30 Then l_month = 12: l_day = 31 Else l_month = 9: l_day = 30
        Else
          If l_month = 12 And l_day = 31 Then
            l_month = 3: l_day = 31: l_year = l_year + 1
          Else
            l_month = 12: l_day = 31
          End If
        End If
        
       ->nächstes Datum zusammensetzen
        s_date = l_day & . & l_month & . & l_year
        d_date = s_date
        
       ->Datum eintragen
        ActiveCell.Offset(1, 0).FormulaR1C1 = d_date
        
       ->Zelle aktivieren
        ActiveCell.Offset(1, 0).Activate
      Next
    End Sub
     
  4. @ Matjes
    Ich hab mein voriges Posting jetzt korrigiert und würde eine Variante deines ersten Vorschlags bevorzugen.

    Ausarbeitung kommt aber erst morgen. Mal schaun, wie es dir gefällt.
     
  5. Hallo klexy,

    mit dem 20.1.2005 als Ausgangsdatum haut es noch nicht hin. Da folgt dann 31.3.2006, 30.6.2006, ...

    Gruß Matjes :)
     
  6. Hallo Matjes,

    das kommt davon, wenn man nicht bei seinen Formeln bleibt. Der Makro-Aufzeichnungsmodus akzeptiert nur wenige Zeichen pro Zelle, wodurch man längere Formeln beim Aufzeichnen in EInzelteile zerlegen muß, um sie nachher zu einer Formel zusammen zufassen. Und da wird's dann haarig.

    So isses aber korrekt:
    Code:
    Sub Ultimo_drunter()
    
    ActiveCell.Offset(1, 0).Select
      ActiveCell.FormulaR1C1 = _
        =IF(AND(MONTH(R[-1]C)>=1,MONTH(R[-1]C)<=3,R[-1]C<>DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),3,31), & Chr(10) & _
        IF(OR(AND(MONTH(R[-1]C)>=4,MONTH(R[-1]C)<=6,R[-1]C<>DATE(YEAR(R[-1]C),6,30)),R[-1]C=DATE(YEAR(R[-1]C),3,31)),DATE(YEAR(R[-1]C),6,30), & Chr(10) & _
        IF(OR(AND(MONTH(R[-1]C)>=7,MONTH(R[-1]C)<=9,R[-1]C<>DATE(YEAR(R[-1]C),9,30)),R[-1]C=DATE(YEAR(R[-1]C),6,30)),DATE(YEAR(R[-1]C),9,30), & Chr(10) & _
        IF(OR(AND(MONTH(R[-1]C)>=10,MONTH(R[-1]C)<=12,R[-1]C<>DATE(YEAR(R[-1]C),12,31)),R[-1]C=DATE(YEAR(R[-1]C),9,30)),DATE(YEAR(R[-1]C),12,31), & Chr(10) & _
        if(R[-1]C=DATE(YEAR(R[-1]C),12,31),DATE(YEAR(R[-1]C)+1,3,31),)))))
    'Selection.Copy
    'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
      
      
    ActiveCell.Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = _
        =IF(MONTH(R[-1]C)<=3,  & Chr(10) & _
        IF(AND(MONTH(R[-1]C)=3,DAY(R[-1]C)=31),DATE(YEAR(R[-1]C),6,30),DATE(YEAR(R[-1]C),3,31)), & Chr(10) & _
        IF(MONTH(R[-1]C)<=6,  & Chr(10) & _
        IF(AND(MONTH(R[-1]C)=6,DAY(R[-1]C)=30),DATE(YEAR(R[-1]C),9,30),DATE(YEAR(R[-1]C),6,30)), & Chr(10) & _
        IF(MONTH(R[-1]C)<=9,  & Chr(10) & _
        IF(AND(MONTH(R[-1]C)=9,DAY(R[-1]C)=30),DATE(YEAR(R[-1]C),12,31),DATE(YEAR(R[-1]C),9,30)), & Chr(10) & _
        IF(AND(MONTH(R[-1]C)=12,DAY(R[-1]C)=31),DATE(YEAR(R[-1]C)+1,3,31),DATE(YEAR(R[-1]C),12,31)))))
    
    'Selection.Copy
    'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      Application.CutCopyMode = False
      
    End Sub
    Deine Methode ist als rein Makro-basierte Methode eleganter, aber bei meiner kann man das PasteSpecial auskommentieren und hat so die Formel dastehen. Das ist dann ein gutes Beispiel, um die Funktionsweise von wenn-dann-Formeln zu begreifen. Jetzt sogar mit Zeilenumbrüchen innerhalb der Formel in der Zelle. Und sogar noch in zwei verschiedenen Herangehensweisen (die zweite nach der Logik in deinem zweiten Makro). Lerneffekt als Abfallprodukt.

    Für die endgültige Fassung bin ich noch auf der Suche nach einer Eingabe der Anzahl c_ANZAHLZELLEN über ein Eingabefeld in einem Popup. Das war vor ein paar Tagen hier Thema in anderem Zusammenhang. Mal schaun, ob ich das kombinieren kann.
     
  7. Hallo klexy,

    super  :D :D :D

    Die Lesbarkeit durch Zeilenumbrüche in der Formel ist mir vorher nie in den Kopf gekommen. Bei größeren Formeln hab ich immer Notepad benutzt.

    Toll  :D So machen Formeln Spaß  ;D

    Gruß Matjes :)
     
Die Seite wird geladen...

Excel: Datum per Formel/VBA berechnen - Ähnliche Themen

Forum Datum
Bedingte Formatierung Excel 2010 bei Datum Microsoft Office Suite 11. Okt. 2012
Datumsberechnung in Excel 2007 Microsoft Office Suite 14. Juni 2012
Excel, Zahlen werden zum Datum Microsoft Office Suite 29. Okt. 2010
EXCEL 2000: Datum ist nicht gültig Microsoft Office Suite 2. Feb. 2010
Excel: aktuelle Datumszeile farbig markieren Microsoft Office Suite 15. Jan. 2010