Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Datumsreihe vervollständigen





Frage

Hallo zusammen ! Mein Problem besteht darin, dass ich in einer Spalte verschiedene Datums habe, die bereits in der richtigen chronologischen Reihenfolge stehen. Allerdings fehlen einige. Zum Beispiel steht in A2 01.01.2007 und in A3 04.01.2007. Ich möchte jetzt per Makro diese Lücken schließen. Das Makro soll also in der Spalte A schauen, ob ein Datum fehlt und wenn dies der Fall ist eine Zeile einfügen, in der das fehlende Datum automatisch eingetragen wird. Geht sowas?? Ich hoffe doch ! Danke schon mal an alle Grüße Toni

Antwort 1 von nighty

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

Antwort 2 von coros

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.

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


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.

Antwort 3 von Toni165

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

Antwort 4 von coros

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.

Antwort 5 von Toni165

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

Antwort 6 von coros

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.

Antwort 7 von Toni165

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

Antwort 8 von coros

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.

Antwort 9 von coros

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.

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


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.

Antwort 10 von Toni165

Hallo Oliver,


Spitzenklasse-Makro !!!

Es funktioniert genau so wie ich mir das vorgestellt habe.

Vielen Dank

Grüße
Toni

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: