Datum und Zeit schreiben und fixieren

[Plasgo]

Hallo zusammen,

ich komme einfach nicht weiter ...

Ich habe eine Excel Liste mit 6 Spalten und 500 Zeilen. Die 500 Zeilen werden erweitert mit der Zeit und die Spalten bleiben bei 6.

Wenn in Spalte B zb. B3 eine Zahl eingetragen wird, dann soll in Spalte D also D3 das Datum und die Uhrzeit geschrieben werden und das dann für jede weitere Zeile. Wenn die Spalte B neu beschrieben wird, soll sich das Datum aktualisieren in Spalte D. Geht das?

Mit einer Formel komme ich hier nicht weiter und mit VBA kenne ich mich leider nichts aus. Ich habe schon gelesen, dass es hier einen Lösungsweg gibt.

Wie kann ich das am besten lösen?

Herzliche Grüße Christian

[echo]

Hallo  Christian
du kannst mal nach "Zeit stempeln" suchen, da gibt ein einiges an VBA-Lösungen

Eine Formellösung ist auch möglich, wenn du vorher in den Optionen >> Formeln die "interaktive Berechnung" aktivierst.
Das ist Bedingung das bei der folgenden Formel der Zirkelbezug unterdrückt wird.

Formel in D3 :
=WENN(B3="";"";WENN(D3<>"";D3;JETZT()))
Zellformat zB.
TT.MM.JJJJ hh:mm

Datum/Uhrzeit ändert sich aber erst wenn der Inhalt die Zelle B3 wieder gelöscht wird.
Sonnst müsstest du dich vermutlich für ein Makro entscheiden

Gruß Holger

[HKindler]

Hi,

Vorsicht! Die Erfahrung zeigt, dass die Formellösung auf Dauer nicht zuverlässig funktioniert. Das liegt daran, dass sich zwar Excel den Zustand der Option "interaktive Berechnung" zwar pro Datei merkt, dies aber eine globale Einstellung in Excel ist. Sobald nun mehrere Dateien in Excel offen sind, muss sich Excel für die Option einer Datei entscheiden. Und der aktuelle Zustand der Option wird bei jedem speichern der Datei mitgespeichert. Irgendwann wird also die Datei mit ausgeschalteter Option gespeichert und allerspätestens dann ist sie kaputt.

Daher rate ich von der Formellösung ab. Beiß in den sauren Apfel und verwende eine VBA-Lösung. Damit wirst du auf Dauer glücklicher.

[DIZA]

Hallo Plasgo,

Helmut Recht gebend, hier ein Ansatz.

Pack mal folgenden Code in das entsprechende Tabellenblatt. (Rechtsklick auf den Tabellenreiter und Code anzeigen)

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Variant, qlz As Long, rc As Long, cc As Long, rs As Long, cs As Long
qlz = Cells(Rows.Count, 2).End(xlUp).Row
If Target.Column > 1 And Target.Column < 3 Then
Application.EnableEvents = False
   If Target.Count > 1 Then
      rc = Selection.Rows.Count
      cc = Selection.Columns.Count
      rs = Selection.Row
      cs = Selection.Column
      Range("D" & rs & ":D" & rs + rc - 1).Value = Now
   Else
      Range("D" & Target.Row).Value = Now
   End If
Application.EnableEvents = True
   Columns("D:D").EntireColumn.AutoFit
End If
End Sub

Rückmeldung wäre schön.

[HKindler]

Hi Dirk,

hier eine Rückmeldung von mir. In deinem Code sehe ich mehrere Probleme:

Wenn man A1:C1 gleichzeitig ändert (also markiert, etwas eingibt und dann Strg-Enter drückt), dann passiert nichts, weil Target.Column =1 ist.

Wann man B1 und B3 gleichzeitig ändert (also B2 nicht markiert hatte), dann wird nur B1 in D1 protokolliert, B3 hingegen nicht.

Wenn man einen Eintrag in Spalte C löscht, wird das zugehörige Datum nicht mit gelöscht, sondern das Löschen protokolliert.

Ich würde es so lösen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Intersect(Target, Range("B:B"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        If Zelle <> "" Then
            Cells(Zelle.Row, "D") = Now
        Else
            Cells(Zelle.Row, "D").ClearContents
        End If
    Next Zelle
End If
End Sub

bzw. wenn das Löschen in Spalte B ebenfalls protokolliert werden soll

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Intersect(Target, Range("B:B"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        Cells(Zelle.Row, "D") = Now
    Next Zelle
End If
End Sub

[DIZA]

Hallo Helmut

-> Wenn man A1:C1 gleichzeitig ändert (also markiert, etwas eingibt und dann Strg-Enter drückt), dann passiert nichts, weil Target.Column =1 ist. -> stimmt, bin ich nicht von ausgegangen
-> Wann man B1 und B3 gleichzeitig ändert (also B2 nicht markiert hatte), dann wird nur B1 in D1 protokolliert, B3 hingegen nicht. -> stimmt, bin ich nicht von ausgegangen
-> Wenn man einen Eintrag in Spalte C löscht, wird das zugehörige Datum nicht mit gelöscht, sondern das Löschen protokolliert. -> dachte, das kann ruhig mit registriert werden.

Ich würde es so lösen:... -> überzeugt  Danke für deinen Input.

[echo]

Daher rate ich von der Formellösung ab. Beiß in den sauren Apfel und verwende eine VBA-Lösung. Damit wirst du auf Dauer glücklicher.

Hallo Helmut, danke für den Hinweis zur Formellösung.
Wirklich ein Grund es besser nicht so zu machen!

Gruß Holger

[HKindler]

Hi,

genau diese Problematik war damals der Grund mich in VBA einzuarbeiten.

[Plasgo]

Vielen Dank. das ist genau das Richtige   Ich teste es jetzt die nächsten Tage, ob der Zusammenspiel des Codes und der Formeln funktioniert. Aber bis jetzt ist es genau das Richtige.

Vielen lieben Dank für eure Unterstützung.

---

Danke für den Code. Den Ersten habe ich eingetragen.

Hi Dirk,

hier eine Rückmeldung von mir. In deinem Code sehe ich mehrere Probleme:

Wenn man A1:C1 gleichzeitig ändert (also markiert, etwas eingibt und dann Strg-Enter drückt), dann passiert nichts, weil Target.Column =1 ist.

Wann man B1 und B3 gleichzeitig ändert (also B2 nicht markiert hatte), dann wird nur B1 in D1 protokolliert, B3 hingegen nicht.

Wenn man einen Eintrag in Spalte C löscht, wird das zugehörige Datum nicht mit gelöscht, sondern das Löschen protokolliert.

Ich würde es so lösen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Intersect(Target, Range("B:B"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        If Zelle <> "" Then
            Cells(Zelle.Row, "D") = Now
        Else
            Cells(Zelle.Row, "D").ClearContents
        End If
    Next Zelle
End If
End Sub

bzw. wenn das Löschen in Spalte B ebenfalls protokolliert werden soll

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Intersect(Target, Range("B:B"))
If Not Bereich Is Nothing Then
    For Each Zelle In Bereich
        Cells(Zelle.Row, "D") = Now
    Next Zelle
End If
End Sub