hi toni :-)

hab da schnell ein älteres makro umgeschrieben,daher ist der code nicht so wie er sein sollte,funktioniert aber

ergänzt die fehlenden datumsangaben und hängt diese an das ende

gruss nighty

Sub jahresdaten()
Dim da(3, 12)
Dim tag$(39), tag1$(7)
da(0, 1) = 31
da(0, 2) = 29
da(0, 3) = 31
da(0, 4) = 30
da(0, 5) = 31
da(0, 6) = 30
da(0, 7) = 31
da(0, 8) = 31
da(0, 9) = 30
da(0, 10) = 31
da(0, 11) = 30
da(0, 12) = 31
da(1, 1) = 31
da(1, 2) = 28
da(1, 3) = 31
da(1, 4) = 30
da(1, 5) = 31
da(1, 6) = 30
da(1, 7) = 31
da(1, 8) = 31
da(1, 9) = 30
da(1, 10) = 31
da(1, 11) = 30
da(1, 12) = 31
da(2, 1) = 31
da(2, 2) = 28
da(2, 3) = 31
da(2, 4) = 30
da(2, 5) = 31
da(2, 6) = 30
da(2, 7) = 31
da(2, 8) = 31
da(2, 9) = 30
da(2, 10) = 31
da(2, 11) = 30
da(2, 12) = 31
da(3, 1) = 31
da(3, 2) = 28
da(3, 3) = 31
da(3, 4) = 30
da(3, 5) = 31
da(3, 6) = 30
da(3, 7) = 31
da(3, 8) = 31
da(3, 9) = 30
da(3, 10) = 31
da(3, 11) = 30
da(3, 12) = 31
tag1$(1) = "Montag"
tag1$(2) = "Dienstag"
tag1$(3) = "Mittwoch"
tag1$(4) = "Donnerstag"
tag1$(5) = "Freitag"
tag1$(6) = "Samstag"
tag1$(7) = "Sonntag"
tag$(0) = "Samstag"
tag$(1) = "Montag"
tag$(2) = "Dienstag"
tag$(3) = "Mittwoch"
tag$(4) = "Donnerstag"
tag$(5) = "Samstag"
tag$(6) = "Sonntag"
tag$(7) = "Montag"
tag$(8) = "Dienstag"
tag$(9) = "Donnerstag"
tag$(10) = "Freitag"
tag$(11) = "Samstag"
tag$(12) = "Sonntag"
tag$(13) = "Dienstag"
tag$(14) = "Mittwoch"
tag$(15) = "Donnerstag"
tag$(16) = "Freitag"
tag$(17) = "Sonntag"
tag$(18) = "Montag"
tag$(19) = "Dienstag"
tag$(20) = "Mittwoch"
tag$(21) = "Freitag"
tag$(22) = "Samstag"
tag$(23) = "Sonntag"
tag$(24) = "Montag"
tag$(25) = "Mittwoch"
tag$(26) = "Donnerstag"
tag$(27) = "Freitag"
tag$(28) = "Samstag"
tag$(29) = "Montag"
tag$(30) = "Dienstag"
tag$(31) = "Mittwoch"
tag$(32) = "Donnerstag"
tag$(33) = "Samstag"
tag$(34) = "Sonntag"
tag$(35) = "Montag"
tag$(36) = "Dienstag"
tag$(37) = "Donnerstag"
tag$(38) = "Freitag"
tag$(39) = "Samstag"

REM das gewünschte jahr,erlaubt ist 2000 bis 2039

jj$ = "2007"

j1 = Val(jj$)
If j1 < 2040 And j1 > 1999 Then
j2 = j1 - 2000
j3 = 1
Do
If j2 < 4 Then
Exit Do
Else
j2 = j2 - 4
j3 = j3 + 1
j4 = j4 + 4
End If
Loop
jk3$ = "0"
tz = 1
j4 = j4 + j2
For t = 1 To 12
For t1 = 1 To da(j2, t)
tt1$ = Str$(t1)
jk1 = Len(tt1$)
If Mid$(tt1$, 1, 1) = " " And jk1 = 2 Then tt1$ = jk3 + Mid$(tt1$, 2, 1)
If Mid$(tt1$, 1, 1) = " " And jk1 = 3 Then tt1$ = Mid$(tt1$, 2, 2)
tt2$ = Str$(t)
jk2 = Len(tt2$)
If Mid$(tt2$, 1, 1) = " " And jk2 = 2 Then tt2$ = jk3 + Mid$(tt2$, 2, 1)
If Mid$(tt2$, 1, 1) = " " And jk2 = 3 Then tt2$ = Mid$(tt2$, 2, 2)
suche1 = tt1$ + "." + tt2$ + "." + jj$
Set suche = ActiveSheet.Range("A1:A" & Rows.Count).Find(suche1, LookIn:=xlValues)
If Not suche Is Nothing Then
Else
ActiveSheet.Cells(ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1) = tt1$ + "." + tt2$ + "." + jj$
End If
tz1 = tz1 + 1
Next t1
Next t
End If
End Sub

Hallo Toni,

nachfolgendes Makro sollte das machen, was Du Dir vorgestellt hast. Kopiere es in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche.

[b]Option Explicit

Sub Datum_vervollständigen()
Dim Datum As Date
Dim i As Integer
Datum = CDate("01.01.2007")
For i = 2 To 366
If Cells(i, 1) <> Datum And Cells(i, 1) <> "" Then
Rows(i).Insert Shift:=xlDown
Cells(i, 1) = Datum
End If
If Cells(i, 1) <> Datum And Cells(i, 1) = "" Then
Cells(i, 1) = Datum
End If
Datum = Datum + 1
Next
End Sub[/b]

Das Makro vervollständigt die Datumswerte in Spalte A

Ich hoffe, Du meintest das so und dass Du klar kommst. Bei Fragen melde Dich bitte.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Nighty, Hallo Oliver


Vielen Dank für eure Vorschläge. :-)
Leider haben beide Makros nicht meine Vorstellungen getroffen.

Das Makro von Nighty hat eine komplette Datumsreihe von 2007 an meine existierende angehängt und das von Oliver hat eine komplette Reihe davor gesetzt.

Ich möchte aber, dass dieses Makro die Lücken in meiner Datumsreihe schließt

22.03.2007
23.03.2007
25.03.2007
26.03.2007

Hier soll das Makro nun den 24.03.2007 zwischen dem 23. und dem 25.03.2007.

Wäre super, wenn ihr mir nochmal helfen würdet.

Grüße Toni

Hallo Toni,

Du kannst davon ausgehen, dass Makros, die hier gepostet werden, auch funktionieren. Es wird an den Angaben liegen, die Du hier gemacht hast. Mein Makro arbeitet die Spalte A (nightys Makro übrigens auch) von Zelle 2 bis Zelle 366 ab. Wenn Deine Daten woanders stehen, kann das auch nicht funktionieren.
Also, wo stehen Deine Daten? Besser noch wäre, wenn Du Deine Datei z.B. bei
www.netupload.de mal hochladen würdest.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo zusammen,

vorab wollte ich loswerden, dass ich sehr dankbar bin für die Hilfe die ich hier bekomme.


Die Datei habe ich hier mal hochgeladen:
http://www.netupload.de/detail.php?img=afc8f95bcaca25912ff8843bf1e9...


In dieser Datumsreihe müsste die Lücken geschlossen werden.

Danke

Hallo Toni,

das Problem, warum mein Makro und sicherlich auch nightys, nicht richtig ist, dass in den Zellen nicht nur ein Datum, sondern auch eine Uhrzeit steht. Das zu lösen ist kein Problem. Mir ist aber in Deiner Datei aufgefallen, dass einige Daten bis zu 8x vorkommen. Zum Beispiel der 25.01.2007 kommt 8x hintereinander vor. Soll das so sein? Das müsste man noch wissen.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

das wäre das zweite Problem. Die Mehrfacheinträge sollen gelöscht werden, sodass nur noch einmal das entsprechende Datum auftaucht.

Grüße
Toni

Hallo Toni,

ich wollte mich nur kurz melden. Auf meine Lösung musst Du unter Umständen bis heute Abend warten, da ich jetzt einen Termin habe und daher erst heute Nachmittag dazu kommen werde, mich weiter um Dein Problem zu kümmern.
Eventuell kommt ja schneller eine Lösung von jemand anderem?
Bis später.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Toni,

hier nochmal ein Schnellschuss, bevor ich zum Termin muss. Nachfolgendes Makro sollte das machen, was Du Dir vorgestellt hast. Kopiere das in ein StandardModul.

[b]Option Explicit

Sub Datum_vervollständigen()
Dim Datum As Date
Dim i As Integer, Zähler As Integer
Application.ScreenUpdating = False
Datum = CDate("01.01.2007")
For i = 2 To 1000
If Datum > "31.12.2007" Then Exit For
If Left(Cells(i + 1, 1), 10) = Datum Then
GoTo Weiter
End If
If Left(Cells(i, 1), 10) <> Datum And Cells(i, 1) <> "" Then
Rows(i).Insert Shift:=xlDown
Cells(i, 1) = Datum
End If
If Left(Cells(i, 1), 10) <> Datum And Cells(i, 1) = "" Then
Cells(i, 1) = Datum
End If
Datum = Datum + 1
Weiter:
Next
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Left(Cells(i, 1), 10) = Left(Cells(i - 1, 1), 10) Then Rows(i).Delete
Next
End Sub[/b]

Bis später.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,


Spitzenklasse-Makro !!!

Es funktioniert genau so wie ich mir das vorgestellt habe.

Vielen Dank

Grüße
Toni