Thema Datum  Von Nutzer Rating
Antwort
05.09.2020 14:24:28 Michael Rasche
NotSolved
05.09.2020 15:07:28 Mase
NotSolved
05.09.2020 15:09:20 Mase
NotSolved
05.09.2020 18:46:50 xlKing
NotSolved
05.09.2020 19:00:19 xlKing
NotSolved
Blau Datumsstempel
05.09.2020 19:23:54 xlKing
Solved
06.09.2020 10:35:12 Gast60612
NotSolved

Ansicht des Beitrags:
Von:
xlKing
Datum:
05.09.2020 19:23:54
Views:
533
Rating: Antwort:
 Nein
Thema:
Datumsstempel

Hallo, ich nochmal :-)

Hier noch ein geringfügig angepasster Code der die vorgenannten Probleme umgeht. Wie gesagt gehört der Code in das Modul "DieseArbeitsmappe"

Dim arr As Variant, NoCalculation As Boolean

Private Sub Workbook_Open()
  Dim lastzei As Long
  lastzei = Cells(Rows.Count, Range("AB14").Column).End(xlUp).Row
  arr = Range("AB14:AB" & lastzei) 'Vergleichsdaten werden temporär gespeichert
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  
  On Error GoTo Fehler
  
  Dim lastzei As Long
  lastzei = Cells(Rows.Count, Range("AB14").Column).End(xlUp).Row
  With Range("AB14:AB" & lastzei)
    For i = 1 To .Cells.Count 'Aktuelle Werte werden mit Vergleichsdaten verglichen.
      NoCalculation = True
      If i > UBound(arr) Then 'Wenn Werte hinzugekommen sind (also wenn neue Zeilen!)
        .Cells(i).Offset(0, 4).Value = Date   'Die 4 steht für 4 Spalten Versatz
      ElseIf .Cells(i) <> arr(i, 1) Then 'Wenn sich Werte geändert haben
        .Cells(i).Offset(0, 4).Value = Date   'AF befindet sich 4 Spalten nach AB
      End If
      NoCalculation = False
    Next i
  End With
  
  Workbook_Open
  Exit Sub
  
Fehler:
  Workbook_Open
  Resume
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  If NoCalculation = False Then
    Workbook_BeforeSave False, True
  End If
End Sub

Nun werden bei jeder ausgelösten Neu-Berechnung die Werte auf Änderung geprüft und das Datum eingefügt. Dadurch kann aber das Workbook extrem langsam werden, wenn du viele Zeilen hast. In dem Fall schmeiße einfach das Calculation-Ereignis aus dem Code wieder raus.

Gruß Mr. K.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.09.2020 14:24:28 Michael Rasche
NotSolved
05.09.2020 15:07:28 Mase
NotSolved
05.09.2020 15:09:20 Mase
NotSolved
05.09.2020 18:46:50 xlKing
NotSolved
05.09.2020 19:00:19 xlKing
NotSolved
Blau Datumsstempel
05.09.2020 19:23:54 xlKing
Solved
06.09.2020 10:35:12 Gast60612
NotSolved