Wenn Formel/Makro

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim RaBereich As Range ' abbrechen, wenn erste Zeile oder mehr als eine Zelle aktiv If Target.Row 1 Then Exit Sub 'für Änderungen Zellbereich Ggf anpassen Set RaBereich = Range("A3:A12") Application.EnableEvents = False 'bei Änderung eine Zelle rechts davon Datum und Uhrzeit eintragen If Not Intersect(Target, RaBereich) Is Nothing Then Target.Offset(0, 1) = format(Now, "dd.mm.yyyy_hh:mm:ss") End If Application.EnableEvents = True Set RaBereich = Nothing End Sub

Hallo ede,
Dein Makro erfüllt wohl schon fast die gewünschten Anforderungen.
Ich frage mich (bzw. DICH) nur, weshalb das Makro abgebrochen wird, wenn mehr als 1 Zelle geändert wurde (bspw. Bereich A3:A5 markieren und per ENTF löschen oder Eingabe in diesem Bereich per STRG+ENTER abschliessen etc.). Weshalb verfolgst Du nicht konsequent den Dir bekannten WEG (INTERSECT) ?
Ich habe mir erlaubt, das Makro entsprechend zu korrigieren, dann klappt es auch für Änderungen in mehrzelligen Bereichen :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim RaBereich As Range, RaZelle As Range
    'für Änderungen Zellbereich Ggf anpassen
    Set RaBereich = Range("A3:A12")
    Application.EnableEvents = False
    'bei Änderung eine Zelle rechts davon Datum und Uhrzeit eintragen
    If Not Intersect(Target, RaBereich) Is Nothing Then
        For Each RaZelle In Intersect(Target, RaBereich)
            RaZelle.Offset(0, 1) = Format(Now, "dd.mm.yyyy_hh:mm:ss")
        Next
    End If
    Application.EnableEvents = True
    Set RaBereich = Nothing
End Sub
Schönen Tag wünscht NoNet

Hallo Andreas,
wenn du eine zusätzliche Spalte übrig hast, dann könnte man das so lösen.
' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Calculate()
Dim rng As Range

On Error GoTo ErrExit
Application.EnableEvents = False

For Each rng In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If rng.HasFormula Then
        If rng.Value <> rng.Offset(0, 2).Value Then
            rng.Offset(0, 1) = Date
            rng.Offset(0, 2) = rng.Value
        End If
    End If
Next

ErrExit:
Application.EnableEvents = True
End Sub

Die Spalte zur Zwischenspeicherung der Werte kann man auch ausblenden.

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread