AW: zellenwert vorher und nachher vergleichen
08.02.2016 07:17:34
Werner
Hallo Torsten,
ich hab mal noch ein wenig gebastelt. Wichtig vor allem, der Code den du bereits hast, läuft in einen Fehler, wenn mehrere Zellen ausgewählt werden. Bei diesem Code jetzt wurde dieser Fehler abgefangen, eine Mehrfachauswahl wird mit entsprechender Meldung unterbunden.
Zusätzlich habe ich jetzt die Ausgabe der Protokolldaten auf Tabellenblatt 2 ausgelagert -musst du halt an deine Bedürfnisse anpassen.
Und bei der ganzen Sache bedenken, dass es datenschutzrechtlich bedenklich sein könnte.
Code in allgemeines Modul
Option Explicit
Public vorher_nacher As String
Public Quelle As String
Public Ziel As Long
Public Sub prüfung()
Application.EnableEvents = False
If Sheets("Tabelle1").Range(Quelle).Font.Strikethrough = True Then
Sheets("Tabelle2").Cells(Ziel, 1).Value = vorher_nacher
Sheets("Tabelle2").Cells(Ziel, 2).Value = "in Zelle " & Quelle
Sheets("Tabelle2").Cells(Ziel, 3).Value = "gestrichen am "
Sheets("Tabelle2").Cells(Ziel, 4).Value = Now()
Sheets("Tabelle2").Cells(Ziel, 5).Value = "durch " & Application.UserName
End If
vorher_nacher = ""
Quelle = ""
Application.EnableEvents = True
End Sub
Code im Tabellenblatt
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target "" Then
vorher_nacher = Target.Value
Quelle = Target.Address
Ziel = Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheets("Tabelle1")
If Target.Count > 1 Then
MsgBox "Mehrfachauswahl nicht zulässig"
ActiveCell.Select
End If
If Quelle "" Then
.Range(Quelle).Value = .Range(Quelle).Value
Call prüfung
End If
End With
End Sub
Gruß Werner