In Excel das Datum automatisch einfügen

Computer: Software & Programmierung Visual Basic
#1

Hallo Zusammen,

ich möchte gerne in einer Excel Datei eine Funktionalität einbauen, die es mir erlaubt eine „Liste offener Punkte“ zu verwenden. D.h. im Konkreten, dass ich wenn ich in Spalte „J“ die Zelle auf „erl.“ setze, dann soll mir in der Spalte „M“ das aktuelle heutige Datum eingefügt werden. ABER es soll sich nicht mehr ändern, nachdem ich die Datei gespeichert habe und neu öffne. Solange die Zeile nicht auf „erl.“ gesetzt wird, soll die Spalte „M“ leer bleiben.
Damit fällt leider eine „einfache“ Lösung mit =heute() und einer WENN Abfrage raus. Das müsste über VBA gehen, leider fehlt mir dazu der Ansatz. Kann mir da jemand helfen?

Weil das ja sonst viel zu einfach wäre, hier noch als Bonus, dass diese ganze Funktionalität erst ab der Zeile 29 gehen soll, da drüber andere „ausgeblendete“ Inhalte drinnen sind.

Vielen Dank im Voraus!

VG,
Krafty

P.S. Folgenden Artikel hab eich bereits gelesen, aber er triffts nicht genau.

/t/excel-datum-automatisch-einfuegen-aber-nicht-aend…

#2

Hallo Zusammen,

ich möchte gerne in einer Excel Datei eine Funktionalität
einbauen, die es mir erlaubt eine „Liste offener Punkte“ zu
verwenden. D.h. im Konkreten, dass ich wenn ich in Spalte „J“
die Zelle auf „erl.“ setze, dann soll mir in der Spalte „M“
das aktuelle heutige Datum eingefügt werden. ABER es soll sich
nicht mehr ändern, nachdem ich die Datei gespeichert habe und
neu öffne. Solange die Zeile nicht auf „erl.“ gesetzt wird,
soll die Spalte „M“ leer bleiben.
Damit fällt leider eine „einfache“ Lösung mit =heute() und
einer WENN Abfrage raus. Das müsste über VBA gehen, leider
fehlt mir dazu der Ansatz. Kann mir da jemand helfen?

Hallo Krafty,

unklar ist noch was geschehen soll wenn erl. fälschlicherweise eingetragen wurde in Jx, also wieder gelöscht wird, soll dann das Datum in M auch wieder raus?

Option Explicit
'
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim Zelle As Range
'ggfs. die 5000 anpassen
Set Target = Intersect(Target, Range("J29:J5000"))
If Target Is Nothing Then Exit Sub
For Each Zelle In Target
 If Zelle.Value = "erl." Then
 Zelle.Offset(0, 3).Value = Format(Now, "dd.mm.yyyy")
 End If
Next Zelle
End Sub

Gruß
Reinhard

#3

Hallo Reinhard,

super, danke für die schnelle Antwort!

Ja da hast du recht, das hatte ich vorhin vergessen. Es ist so, dass dann das Datum in M wieder rausgelöscht werden sollte.

Ich werde gleich mal den Code ausprobieren.
Danke!

Gruß,
Krafty

#4

Ja da hast du recht, das hatte ich vorhin vergessen. Es ist
so, dass dann das Datum in M wieder rausgelöscht werden
sollte.

Hallo Krafty,

okay, jetzt ist der Code so, nur wenn in J „erl.“ geschrieben wird, kommt das Datum in M, ansonsten wird M leer.

In J könntest du über Daten–Gültigkeit nur die Eingabe „erl.“ oder leer erlauben, somit vermeidest du erl, ert. usw.

Private Sub Worksheet\_Change(ByVal Target As Range)
Dim Zelle As Range
'ggfs. die 5000 anpassen
Set Target = Intersect(Target, Range("J29:J5000"))
If Target Is Nothing Then Exit Sub
For Each Zelle In Target
 Zelle.Offset(0, 3).Value = IIf(Zelle.Value = "erl.", Format(Now, "dd.mm.yyyy"), "")
Next Zelle
End Sub

Gruß
Reinhard

#5

Hallo Reinhard,

noch mal danke! Der Code funktioniert, allerdings habe ich leider das Problem, dass im Tabellenblatt in dem der Code angewendet werden soll, bereits zahlreiche andere Prozeduren enthalten sind. So auch die _Change Funktion.
Der Code sieht dabei wie folgt aus:

Private Sub Worksheet_Change(ByVal objTarget As Range)

Dim objAddIn As Object, vResult As Variant, objTemp As Object
On Error GoTo HandleErr
’
If m_objAddIn Is Nothing Then
If GetStructura(objTemp) >= 0 Then
Set m_objAddIn = objTemp
End If
End If

If Not m_objAddIn Is Nothing Then
vResult = m_objAddIn.StructuraChange(Me, objTarget)
End If
’
ExitHere:

Exit Sub
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.description, vbCritical, „tblMain.Worksheet_Change“
End Select
Resume ExitHere
Resume Next

D.h. dass ich deinen Code irgendwie da einbauen müsste, da Excel sonst leider ja nicht weiß welche _Change Prozedur er anwenden soll.

Ich kann zwar einigermaßen Codes lesen und verstehen, aber ich bin ein ziemlicher Anfänger was den konkreten Umgang mit der Programmierung angeht.

VG,
Krafty

#6

allerdings habe ich
leider das Problem, dass im Tabellenblatt in dem der Code
angewendet werden soll, bereits zahlreiche andere Prozeduren
enthalten sind. So auch die _Change Funktion.

Hallo Krafty,

probier es mal so:

Private Sub Worksheet\_Change(ByVal objTarget As Range)
Dim objAddIn As Object, vResult As Variant, objTemp As Object
Dim Zelle As Range
'ggfs. die 5000 anpassen
Set Target = Intersect(objTarget, Range("J29:J5000"))
If Not Target Is Nothing Then
 For Each Zelle In Target
 Zelle.Offset(0, 3).Value = IIf(Zelle.Value = "erl.", Format(Now, "dd.mm.yyyy"), "")
 Next Zelle
End If
' 
If m\_objAddIn Is Nothing Then
 If GetStructura(objTemp) \>= 0 Then
 Set m\_objAddIn = objTemp
 End If
End If
If Not m\_objAddIn Is Nothing Then
 vResult = m\_objAddIn.StructuraChange(Me, objTarget)
End If
' 
ExitHere:
Exit Sub
HandleErr:
Select Case Err.Number
 Case Else
 MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "tblMain.Worksheet\_Change"
End Select
End Sub

Gruß
Reinhard

#7

Hallo Reinhard,

vielen vielen Dank für deine Hilfe. Ich dachte, dass ich schon längst geantwortet hätte, aber mein Artikel wurde leider nicht gespeichert.

Ich habe den Code so angewendet wie du gesagt hast, leider sagt mir der Debugger gleich in der ersten Codezeile, dass eine Variable nicht definiert ist?

kannst du damit etwas anfangen?

Viele Grüße,
Krafty

#8

Ich habe den Code so angewendet wie du gesagt hast, leider
sagt mir der Debugger gleich in der ersten Codezeile, dass
eine Variable nicht definiert ist?

Hallo Krafty,

ich habe mir den Code grad nochmal sehr flüchtig angesehen. Scheinbar hab ich den irgendwo gemopst, ist ja okay, wird so gemacht.

Ändere überall wo da objTarget steht das ab in Target.

Dann müßte zumindest der Variablenfehler weg sein und berichte. Muß grad kurz weg, wenn es immer noch nicht klappt schau ich danach mal genauer auf den Code.

Ich hab jetzt deine eigentliche Anfrage nicht vor Augen, wenn du meinst, eine Beispielmappe wäre hilfreich, dann lad eine hoch mit file-upöoad, s. FAQ:2606

Gruß
Reinhard