Excel '97 VBA: Darauffolgende Quartale aus aktuellem Datum berechnen

[polaroid]

Hallo zusammen.

Ich erstelle gerade eine UserForm mit der Eingabe von den nächsten Quartalsbeginnen. Im Moment stehen als Möglichkeiten in der Combobox also der 01.07.13, der 01.10.13, der 01.01.14, und der 01.04.14 zur Auswahl.

Ich möchte das ganze aber gern variabel gestalten, sodass auch im nächsten Jahr zum Beispiel die Möglichkeiten entsprechend angepasst werden.

Im Moment sieht das ganze noch recht übersichtlich aus, und zwar so:

Private Sub UserForm_Initialize()
Dim tblDaten As Worksheet
Dim i As Integer
  
 With ComboBox6
 .AddItem "01.07.2013"
 .AddItem "01.10.2013"
 .AddItem "01.01.2014"
 .AddItem "01.04.2014"
 .AddItem "01.07.2014"
 .AddItem "01.10.2014"
 
 End With

Kann mir jemand dabei helfen wie ich meine Idee verwirkliche? Das wäre grandios!

Beste Grüße, Christian

 

[tschomue]

Hallo Christian,

schau dir mal meinen Code an.
Hoffe das hilft dir weiter.

Private Sub UserForm_Initialize()
    
    Dim maxQuartale As Integer
    Dim aktMonat As Integer
    Dim aktJahr As Integer
    Dim quartalMonat As Integer

    maxQuartale = 6
    aktMonat = Month(Now)
    aktJahr = Year(Now)
    
        Select Case aktMonat
        
            Case 1, 2, 3
                quartalMonat = 1
               
            Case 4, 5, 6
                quartalMonat = 4
                
            Case 7, 8, 9
                quartalMonat = 7

            Case 10, 11, 12
                quartalMonat = 10
        End Select
        
    With ComboBoxQuartal
                
        For i = 1 To maxQuartale
            
            If quartalMonat + 3 > 10 Then
                quartalMonat = 1
                aktJahr = aktJahr + 1
            Else
                quartalMonat = quartalMonat + 3
            End If
            
            .AddItem Format(1, "00") & "." & Format(quartalMonat, "00") & "." & aktJahr

        Next
                    
    End With
        
End Sub

Viele Grüße

PS: Hoffe das funktioniert alles auch noch unter Excel '97, habe obigen Code mit Excel 2010 geschrieben.

 

[GMG-CC]

Hallo Christian,

eine Alternative, die etwas "schlanker" ist (aber nicht geprüft!):

Sub Quartale2()
   Dim datDatum As Date
   Dim AnzQrt As Integer, i As Integer
   Dim aQuartalsBeginn()
   datDatum = Sheets("Tabelle1").Cells(1, 1)
   AnzQrt = 6
   ReDim aQuartalsBeginn(AnzQrt)
   For i = 1 To AnzQrt
   aQuartalsBeginn(i) = DateSerial(Year(datDatum), (WorksheetFunction.RoundUp(Month(datDatum) / 3, 0) * 3 - 2) + i * 3, 1)
   'Debug.Print aQuartalsBeginn(i) ' Für die Testpahase
   Next i
   For i = 1 To AnzQrt
      ComboBox6.AddItem aQuartalsBeginn(i)
   Next i
End Sub

Sollte ab Excel 2000 funktionieren.

 

[polaroid]

tschoemue's Code hat funktioniert, vielen Dank! Bald kriegen wir dann auch mal Windows 7 + Office 2013 sodass ich bald wieder alles umbasteln darf.

LG