Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Datum automatisch erkennen+Kalender

Betrifft: Datum automatisch erkennen+Kalender von: Tim
Geschrieben am: 06.08.2014 17:22:13

Hallo zusammen,

ich komme bei folgendem nicht weiter und hoffe Ihr könnt mir helfen.

https://www.herber.de/bbs/user/91939.xlsm

1. Das es automatisch erkennt in welchem Jahr es startet. Gibt man z.B. in "B12" den 10.02.2010 und in "C12" den 15.06.2011 ein, setzt es mir im Jahrblock 2010 im Monat 2, 18 Tage und geht bis zum Jahrblock 2011 zum Monat 6, mit 15 Tage. Die Monate dazwischen übernimmt es mir die Tage des jeweiligen Monats. Das ist auch alles korrekt.
Schreib ich aber in "B12" z.B den 08.03.2011 - 15.09.2011 passt schon was nicht. Es setzt mir zwar im Jahrblock 2011 den Anfangs und End Tag, aber die Monate dazwischen setzt es im Jahrblock 2010 und nicht 2011

Es gibt 4 Jahresblöcke (2010,2011,2012,2013). Gibt es dann die Möglichkeit, wenn man ein Zeitraum eingibt("B12-"C12") und ("B16"-"C16") sich es dann das jeweilige Datum korrekt zuordnet?
Und ist es noch Möglich wenn ich die Jahre in "A25,A41,A57,A73" änder, ich dies auch nicht im Code umstellen muss, sondern dies bei Eingabe eines Zeitraums es automatisch erkennt?

2. Das es mir in "D19" nur die Punkte von diesem Zeitraum ("B19,C19") errechnet und einfügt. Die Punkte stehen in "A"

3. Das es mir nochmal das Datum von "B19" in "B20" übernimmt und dieses dann in "C20" ein Jahr drauf zählt.
Steht also z.B dann in "B20" 16.06.2010 sollte es in "C20" den 15.06.2011 einsetzen.
Und auch in "D20" dann die Punkte von diesem Zeitraum errechnen und einfügen. Punkte stehen in "A"

4. Klasse wäre es noch, wenn man in "B12, C12" und "B16, C16" bei klick auf die Zelle ein Kalender aufgeht, der den ausgewählten Tag in die Zelle gleich einfügt. Und das wenn möglich ohne diesen Steuerelement Kalender unter VBA Zusatzfunktionen.

anbei noch mein Code:


Private Sub CommandButton1_Click()

    Dim Start As Date
    Dim Ende As Date
    Dim Monat As Long
    Dim i As Long

    Start = Me.Range("B12").Value
    Ende = Me.Range("C12").Value

    Select Case Year(Start)
      Case "2010"
          Range("D" & 26 + Month(Start)) = Range("C" & 26 + Month(Start)) - Day(Start)
      Case "2011"
          Range("D" & 42 + Month(Start)) = Range("C" & 26 + Month(Start)) - Day(Start)
    End Select
    
    Select Case Year(Ende)
    Case "2010"
        Me.Range("D" & 26 + Month(Ende)) = Day(Ende)
    Case "2011"
        Me.Range("D" & 42 + Month(Ende)) = Day(Ende)
    End Select
    
    For i = 1 To DateDiff("m", Start, Ende) - 1
        If Month(Start) + i > 12 Then
            Me.Range("D" & 42 + Month(Start) + i - 12) = _
            Me.Range("C" & 42 + Month(Start) + i - 12)
        Else
            Me.Range("D" & 26 + Month(Start) + i) = Me.Range("C" & 26 + Month(Start) + i)
        End If
    Next i
    
    Start = Me.Range("B16").Value
    Ende = Me.Range("C16").Value

    Select Case Year(Start)
    Case "2010"
        Me.Range("F" & 26 + Month(Start)) = Range("C" & 26 + Month(Start)) - Day(Start)
    Case "2011"
        Me.Range("F" & 42 + Month(Start)) = Range("C" & 26 + Month(Start)) - Day(Start)
    End Select
    
    Select Case Year(Ende)
    Case "2010"
        Me.Range("F" & 26 + Month(Ende)) = Day(Ende)
    Case "2011"
        Me.Range("F" & 42 + Month(Ende)) = Day(Ende)
    End Select

    For i = 1 To DateDiff("m", Start, Ende) - 1
        If Month(Start) + i > 12 Then
            Me.Range("F" & 42 + Month(Start) + i - 12) = _
            Me.Range("C" & 42 + Month(Start) + i - 12)
        Else
            Me.Range("F" & 26 + Month(Start) + i) = Me.Range("C" & 26 + Month(Start) + i)
        End If
    Next i
    Range("D12") = Application.Sum(Range("E27:E38"))
    Range("D16") = Application.Sum(Range("G27:G38"))
    If Range("C16") = "" Then
      Range("B19").Value = Range("C12") + 1
    Else
      Range("B19").Value = Range("C16") + 1
    End If
    
    Dim Datum As Date
    Dim VarDatum As Date

    Datum = WorksheetFunction.Max _
            (Me.Range("B12").Value, Me.Range("C12").Value, _
             Me.Range("B16").Value, Me.Range("C16").Value)
         
    Datum = "01." & Month(Datum) + 1 & "." & Year(Datum)

    VarDatum = "30.06." & Year(Datum)
    If Datum < VarDatum Then
        Me.Range("C19").Value = VarDatum
    Else
        VarDatum = "31.12." & Year(Datum)
        Me.Range("C19").Value = VarDatum
    End If
End Sub
Danke Euch schonmal

  

Betrifft: AW: Datum automatisch erkennen+Kalender von: fcs
Geschrieben am: 07.08.2014 12:56:24

Hallo Tim,

ich hab mal versucht deine Wunschliste umzusetzen.
zu 1.
im Code ist nur noch die Zelle A25 für das 1. Jahr verankert. Die Daten aller weiteren Jahre werden im Code relativ zu dieser Zelle ermittelt. Wichtig: zwischen jedem Jahresblock müssen so wie jetzt in deiner Tabelle immer 2 Leerzeilen sein, also pro Jahr immer 16 Zeilen.

zu 2.
Die Summe wird berechnet. Es werden immer die Punkte des gesamten Monats summiert, keine anteiligen für den 1./letzten Monat.

zu 3.
Die Datumswerte und die Summe werden ermittelt.

zu 4. Kalender
hier gilt friß oder stirb. Entweder du benutzt einen von MS mitgelieferten integrierten Kalender, bastelst/suchst dir einen selbstgestrickten oder gibst halt von Hand das Datum ein.
Irgendwo in den Tiefen der RECHECHE des Forums gibt es selfmade Kalender, die nicht die integrierten Kalendersteuerelemente benutzen.

Gruß
Franz

Private Sub CommandButton1_Click()

    Dim Start As Date
    Dim Ende As Date
    Dim Monat As Long
    Dim i As Long
    Dim ZeileStart As Long, ZeileEnde As Long
    Dim Jahr1 As Long, ZeileJahr1 As Long
    Dim dblSum As Double
    
'Daten zum 1. Jahr aus Refernzzelle einlesen
    With Me.Range("A25")
        Jahr1 = .Value
        ZeileJahr1 = .Row
    End With
    
'Datumsangaben Zeile 12 bearbeiten
    Start = Me.Range("B12").Value
    Ende = Me.Range("C12").Value
    
    ZeileStart = ZeileJahr1 + (Year(Start) - Jahr1) * 16 + 1 + Month(Start)
    ZeileEnde = ZeileJahr1 + (Year(Ende) - Jahr1) * 16 + 1 + Month(Ende)
    
    Me.Cells(ZeileStart, 4).Value = Me.Cells(ZeileStart, 3) - Day(Start)
    Me.Cells(ZeileEnde, 4).Value = Day(Ende)
    
    
    For i = ZeileStart + 1 To ZeileEnde - 1
        Select Case Me.Cells(i, 2).Value
          Case 1 To 12
            Me.Cells(i, 4).Value = Me.Cells(i, 3)
        End Select
    Next i
    
'Datumsangaben Zeile 16 bearbeiten
    If Me.Range("B16").Value > 0 And Me.Range("C16").Value > 0 Then
    
      Start = Me.Range("B16").Value
      Ende = Me.Range("C16").Value
  
      ZeileStart = ZeileJahr1 + (Year(Start) - Jahr1) * 16 + 1 + Month(Start)
      ZeileEnde = ZeileJahr1 + (Year(Ende) - Jahr1) * 16 + 1 + Month(Ende)
      
      Me.Cells(ZeileStart, 6).Value = Me.Cells(ZeileStart, 3) - Day(Start)
      Me.Cells(ZeileEnde, 6).Value = Day(Ende)
      
      
      For i = ZeileStart + 1 To ZeileEnde - 1
          Select Case Me.Cells(i, 2).Value
            Case 1 To 12
              Me.Cells(i, 6).Value = Me.Cells(i, 3)
          End Select
      Next i
    End If
      
    
'Summenberechnen
    Range("D12") = Application.Sum(Range("E27:E100"))
    Range("D16") = Application.Sum(Range("G27:G100"))
    
'Datumsangaben Zeile 19 ermitteln
    If Range("C16") = "" Then
      Range("B19").Value = Range("C12") + 1
    Else
      Range("B19").Value = Range("C16") + 1
    End If
    
    Dim Datum As Date
    Dim VarDatum As Date

    Datum = WorksheetFunction.Max _
            (Me.Range("B12").Value, Me.Range("C12").Value, _
             Me.Range("B16").Value, Me.Range("C16").Value)
         
    Datum = "01." & Month(Datum) + 1 & "." & Year(Datum)

    VarDatum = "30.06." & Year(Datum)
    
    If Datum < VarDatum Then
        Me.Range("C19").Value = VarDatum
    Else
        VarDatum = "31.12." & Year(Datum)
        Me.Range("C19").Value = VarDatum
    End If
    
    
'Ergebnis für Datumsangaben Zeile 19 ermitteln
    Start = Me.Range("B19").Value
    Ende = Me.Range("C19").Value

    ZeileStart = ZeileJahr1 + (Year(Start) - Jahr1) * 16 + 1 + Month(Start)
    ZeileEnde = ZeileJahr1 + (Year(Ende) - Jahr1) * 16 + 1 + Month(Ende)
    
    dblSum = 0
    For i = ZeileStart To ZeileEnde
        Select Case Me.Cells(i, 2).Value
          Case 1 To 12
            dblSum = dblSum + Me.Cells(i, 1)
        End Select
    Next i
    Me.Cells(19, 4).Value = dblSum
    
'Datumsangaben Zeile 20 ermitteln
    With Me.Range("B19")
      Me.Range("B20").Value = .Value
      'Datum 1 Jahr später
      Me.Range("C20").Value = DateSerial(Year(.Value) + 1, Month(.Value), Day(.Value)) - 1
    End With
'Ergebnis für Datumsangaben Zeile 20 ermitteln
    Start = Me.Range("B20").Value
    Ende = Me.Range("C20").Value

    ZeileStart = ZeileJahr1 + (Year(Start) - Jahr1) * 16 + 1 + Month(Start)
    ZeileEnde = ZeileJahr1 + (Year(Ende) - Jahr1) * 16 + 1 + Month(Ende)
    
    dblSum = 0
    For i = ZeileStart To ZeileEnde
        Select Case Me.Cells(i, 2).Value
          Case 1 To 12
            dblSum = dblSum + Me.Cells(i, 1)
        End Select
    Next i
    Me.Cells(20, 4).Value = dblSum

End Sub



  

Betrifft: AW: Datum automatisch erkennen+Kalender von: Tim
Geschrieben am: 08.08.2014 19:03:37

Hallo Franz,

danke schonmal für deine Mühe.
beim ausführen kommt jetzt bei folgendem die Meldung:
Laufzeitfehler 1004, Anwendungs- oder objektdefinierter Fehler

'Ergebnis für Datumsangaben Zeile 19 ermitteln
Start = Me.Range("B19").Value
Ende = Me.Range("C19").Value

ZeileStart = ZeileJahr1 + (Year(Start) - Jahr1) * 16 + 1 + Month(Start)
ZeileEnde = ZeileJahr1 + (Year(Ende) - Jahr1) * 16 + 1 + Month(Ende)

dblSum = 0
For i = ZeileStart To ZeileEnde
Select Case Me.Cells(i, 2).Value ´hier kommt der Fehler
Case 1 To 12
dblSum = dblSum + Me.Cells(i, 1)
End Select
Next i
Me.Cells(19, 4).Value = dblSum

Gruß
Tim


  

Betrifft: AW: Datum automatisch erkennen+Kalender von: fcs
Geschrieben am: 09.08.2014 12:57:10

Hallo Tim,

da das Makro bei mir ohne Fehler durchläuft, wenn ich in deiner Beispiel-Datei in den 4 Eingabezellen einen Datumswert eintrage und dann das Makro starte, kann ich dir hier nicht weiterhelfen.

Am Aufbau des Tabellenblatts darf nichts grundsätzliches geändert werden, insbesondere Zeilen löschen oder hinzufügen. in dem Fall müssen im Makro die Zelladressen angepasst werden.

Evtl. solltest du deine Datei mit den Eingabedaten nochmals hochladen, bei denen das Makro einen Fehler anzeigt.

Gruß
Franz


 

Beiträge aus den Excel-Beispielen zum Thema "Datum automatisch erkennen+Kalender"