zellenwert vorher und nachher vergleichen

Torsten · 2016-02-07T02:51:11+00:00

Hallo, ich möchte gerne mittels VBA den Zellenwert der aktiven Zelle vergleichen. Funktion soll so laufen: Zellwert vorher z.B. "Test" Zellwert nacher "Test1" jetzt soll eine Reaktion folgen (msgbox o.ä.) Sind die vorher/nacher Werte unverändert soll auch nicht passieren.

Hallo Torsten,
im alten Beitrag hast du doch geschrieben, dass das Problem gelöst ist?
Das Problem hat mir keine Ruhe gelassen und ich habe ein wenig herum gespielt. Versuche mal folgendes:
Code ins Tabellenblatt, in dem er sich auswirken soll

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
vorher_nacher = Target.Value
Quelle = Target.Address
Ziel = Target.Offset(0, 1).Address
With Sheets("Tabelle1")
.Range(Ziel).Value = vorher_nacher
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Sheets("Tabelle1")
If Quelle  "" Then
.Range(Quelle).Value = .Range(Quelle).Value
Call prüfung
End If
End With
End Sub

Code in ein allgemeines Modul

Option Explicit
Public vorher_nacher As String
Public Quelle As String
Public Ziel As String
Public Sub prüfung()
Application.EnableEvents = False
If Sheets("Tabelle1").Range(Quelle).Font.Strikethrough = True Then
Sheets("Tabelle1").Range(Ziel).Value = "gestrichen am"
Sheets("Tabelle1").Range(Ziel).Offset(0, 1).Value = Now()
Sheets("Tabelle1").Range(Ziel).Offset(0, 2).Value = "durch"
Sheets("Tabelle1").Range(Ziel).Offset(0, 3).Value = Application.UserName
End If
vorher_nacher = ""
Quelle = ""
Ziel = ""
Application.EnableEvents = True
End Sub

Am besten testest du mal mit einer neuen Datei.
Derzeit wird im kompletten Blatt "Tabelle1" der rechte Mausklick überwacht. Wird in der Zelle dann der Text durchgestrichen, werden die Protokollierungsdaten ins gleiche Blatt, mit einem Offset zur überwachten Zelle geschrieben. Das müsstest du dann noch an deine Bedürfnisse anpassen.
Gruß 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

zellenwert vorher und nachher vergleichen

Forumthread: zellenwert vorher und nachher vergleichen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial