Automatische Werte befüllen wenn bestimmtes Datum

Hallo!
Ich habe folgendes Excel-Sheet:
In Spalte A soll mittels VBA ein Datum eingefügt werden, zb. 01.09.2008. In Spalte B soll ein Betrag zb. 70,00 eingetragen werden. Bezüglich der Spalte B gibt es kein Problem. Es geht nur um die Spalte A.
Ich will nämlich, dass Excel automatisch jedes Monat ab 01. des Monats mir diesen Betrag reinschreibt, aber nur dann, wenn das Datum erreicht ist. Es sollte so aussehen:
A1= 01.09.2008
A2= 01.10.2008
A3= 01.11.2008 usw...
Leider habe ich das nicht ganz geschafft, kann es leider nur für eine einmalige Prüfung machen, die wie folgt aussieht:


Private Sub Workbook_Open()
Const Datum = #9/1/2008# 'MM/TT/JJJJ
If Date >= Datum Then
Worksheets("Tabelle1").Range("A2") = "01.09.2008"
End If
End Sub

Nachdem ich nun nicht vorhabe, in VBA diesen Code für jedes Datum selbst zu erstellen, ergeht nun meine Frage, ob das anders und einfacher auch geht?
Ich hoffe, dass ihr versteht was ich will und hoffe, dass es irgendwer schafft.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_Open() Dim dat As Date dat = DateSerial(Year(Date), Month(Date), 1) ' = Erster des aktuellen Monats If Date >= dat Then Dim rSuche As Range, rFinde As Range Set rFinde = Sheets("Tabelle1").Range("A:A") Set rSuche = rFinde.Find(what:=dat, Lookat:=xlWhole, LookIn:=xlValues) If rSuche Is Nothing Then If Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row > 2 Then Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0) = dat Else Sheets("Tabelle1").Range("A1") = dat End If End If End If End Sub

Private Sub Workbook_Open() Dim dat As Date dat = DateSerial(Year(Date), Month(Date), 1) ' = Erster des aktuellen Monats If Date >= dat Then Dim rSuche As Range, rFinde As Range Set rFinde = Sheets("Tabelle1").Range("A:A") Set rSuche = rFinde.Find(what:=dat, Lookat:=xlWhole, LookIn:=xlValues) If rSuche Is Nothing Then If Sheets("Tabelle1").Range("A1") "" Then Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0) = dat Else Sheets("Tabelle1").Range("A1") = dat End If End If End If End Sub

Servus,
dann ganz anders:


Private Sub Workbook_Open()
Dim lngletzte As Long, Monat As Long, Jahr As Long, i As Long, k As Long
Dim MonatsDifferenz As Long, JahresDifferenz As Long
With Sheets("Tabelle1")
lngletzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.  _
_
Count)
Select Case .Range("A1")
Case Is = "":
.Range("A1") = DateSerial(Year(Date), Month(Date), 1)
Exit Sub
Case Else
Monat = Month(.Cells(lngletzte, 1))
Jahr = Year(.Cells(lngletzte, 1))
End Select
End With
JahresDifferenz = Year(Date) - Jahr
Select Case JahresDifferenz
Case 0:
MonatsDifferenz = Month(Date) - Monat
Select Case MonatsDifferenz
Case 0:
Exit Sub
Case 1:
With Sheets("Tabelle1")
.Range("A65536").End(xlUp).Offset(1, 0) = DateSerial(Year(Date),  _
Month(Date), 1)
End With
Case Else
For i = Monat + 1 To Month(Date)
With Sheets("Tabelle1")
.Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date),   _
_
i, 1)
End With
Next i
End Select
Case Else
For k = 0 To JahresDifferenz
If k = 0 Then
For i = Monat + 1 To 12
With Sheets("Tabelle1")
.Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date) -  _
JahresDifferenz + k, i, 1)
End With
Next i
Else
For i = 1 To 12
If Year(Date) - JahresDifferenz + k = Year(Date) And i = Month(Date) + 1 Then   _
_
Exit Sub
With Sheets("Tabelle1")
.Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date) -  _
JahresDifferenz + k, i, 1)
End With
Next i
End If
Next k
End Select
End Sub

Hier ist es egal, wie lange du nichts mehr eingetragen hast. das Makro füllt die Differenz vom letzten datum bis zum jetzigen auf, steht nichts in der Tabelle wird das aktuelle Datum (natürlich der Erste des Monats) eingetragen.
Viel Spaß
Gruß
Chris

Private Sub Workbook_Open() Dim lngletzte As Long, Monat As Long, Jahr As Long, i As Long, k As Long Dim MonatsDifferenz As Long, JahresDifferenz As Long With Sheets("Tabelle1") lngletzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows. _ Count) Select Case .Range("A1") Case Is = "": .Range("A1") = DateSerial(Year(Date), Month(Date), 1) + 4 Exit Sub Case Else Monat = Month(.Cells(lngletzte, 1)) Jahr = Year(.Cells(lngletzte, 1)) End Select End With JahresDifferenz = Year(Date) - Jahr Select Case JahresDifferenz Case 0: MonatsDifferenz = Month(Date) - Monat Select Case MonatsDifferenz Case 0: Exit Sub Case 1: With Sheets("Tabelle1") .Range("A65536").End(xlUp).Offset(1, 0) = DateSerial(Year(Date), _ Month(Date), 1) + 4 End With Case Else For i = Monat + 1 To Month(Date) With Sheets("Tabelle1") .Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date), _ i, 1) + 4 End With Next i End Select Case Else For k = 0 To JahresDifferenz If k = 0 Then For i = Monat + 1 To 12 With Sheets("Tabelle1") .Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date) - _ JahresDifferenz + k, i, 1) + 4 End With Next i Else For i = 1 To 12 If Year(Date) - JahresDifferenz + k = Year(Date) And i = Month(Date) + 1 Then _ Exit Sub With Sheets("Tabelle1") .Cells(65536, 1).End(xlUp).Offset(1, 0) = DateSerial(Year(Date) - _ JahresDifferenz + k, i, 1) + 4 End With Next i End If Next k End Select End Sub

Sub Test() Dim lngletzte As Long, Monat As Long, Jahr As Long, i As Long, k As Long Dim MonatsDifferenz As Long, JahresDifferenz As Long With Sheets("Tabelle1") lngletzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows. _ Count) Select Case .Range("A1") Case Is = "": If Day(Date) >= 5 Then .Range("A1") = DateSerial(Year(Date), Month(Date), 1) + 4 Exit Sub Else Exit Sub End If Case Else Monat = Month(.Cells(lngletzte, 1)) Jahr = Year(.Cells(lngletzte, 1)) End Select End With JahresDifferenz = Year(Date) - Jahr Select Case JahresDifferenz Case 0: MonatsDifferenz = Month(Date) - Monat Select Case MonatsDifferenz Case 0: Exit Sub Case 1: With Sheets("Tabelle1") If Day(Date) >= 5 Then .Range("A65536").End(xlUp).Offset(1, 0) = DateSerial(Year(Date), _ Month(Date), 1) + 4 Else Exit Sub End If End With Case Else For i = Monat + 1 To Month(Date) If i = Month(Date) And Day(Date)

Beliebteste Forumthreads (12 Monate)

Automatische Werte befüllen wenn bestimmtes Datum

29
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B
1	01.05.2008	70,00
2	01.06.2008	70,00
3	01.07.2008	70,00
4	01.08.2008	70,00
5	01.09.2008
6	01.10.2008
7	01.11.2008
8	01.12.2008

Automatische Werte befüllen wenn bestimmtes Datum

29 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

29
Beiträge zum Forumthread

Beiträge zu diesem Forumthread