Ändern Sie die Zellenfarbe, wenn sich der Wert ändert

Question

Ich möchte etwas VBA schreiben, um die Farbe der Zelle zu ändern, wenn der Benutzer zu einem anderen Wert auf einem bestimmten Blatt wechselt.

Jeden Monat wird der Benutzer Änderungen an demselben Blatt für diesen Monat vornehmen. Es gibt bestimmte Felder, die der Benutzer ändern wird. Es gibt keine Liste dessen, was die Änderungen sein könnten, da es alles Mögliche sein könnte. Wir haben den Benutzer gebeten, hervorzuheben, ob sie eine Zelle in der Excel-Tabelle ändern. Aber ich möchte ein Makro schreiben, das dies automatisch erkennt. Wenn sie jedoch einen Fehler machen und die Zelle auf ihren ursprünglichen Wert zurücksetzen (Punkt, an dem die Datei geöffnet wurde), ist keine Hervorhebung erforderlich.

Ich habe diesen Code, um die Farbe der Zelle zu ändern, wenn der Wert

Private Sub Worksheet_Change(ByVal Target As Range) 
    Target.Interior.Color = RGB(181, 244, 0) 

End Sub 

ändert Aber wie ändere ich keine Farbe zurück, wenn Wert zurück ursprünglichen Wert geändert wird?

Vielen Dank im Voraus.

Answer 1

Hier ist etwas, das Sie verwenden:

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim rngCell As Range 

    Set rngCell = Sheets(3).Cells(Target.Row, Target.Column) 

    If IsEmpty(rngCell) Then 
     rngCell = Target 
     Target.Interior.Color = RGB(181, 244, 0) 
    Else 
     If rngCell = Target Then 
      Target.Interior.Color = RGB(120, 120, 120) 
     End If 
    End If 

End Sub 

Es den Wert auf dem dritten Blatt setzt, sobald es erstellt wird und macht dann eine Überprüfung, ob es geändert wird oder nicht. IsEmpty(rngCell) ist der Scheck.

Edit: In Bezug auf die Frage nach dem Format

Wenn Sie wollen, versuchen Sie irgendwo folgendes implementieren:

Private Sub CopyFromAtoB(rngA As Range, rngB As Range) 

    rngB.Value = rngA.Value 
    rngA.Copy 
    rngB.PasteSpecial (xlPasteFormats) 
    Application.CutCopyMode = False 

End Sub 

Seien Sie jedoch vorsichtig, da Sie irgendwo eine Endlosschleife eintreten kann, wenn Sie den Wert ändern.

Die Idee ist nicht eine zweite Tabelle ist nicht gut zu verwenden, müssen Sie etwas mit dem vergleichen müssen. Sie können die Werte in einem öffentlichen List oder etwas ähnliches in VBA speichern, aber wenn die Tabelle geschlossen ist oder der VBA-Code gebrochen ist, würden Sie alles verlieren. Und das ist schmerzhaft. Daher ist es nicht das, was ich empfehlen würde.

Wenn Sie es sehr professionell verwenden möchten, verwenden Sie eine SQL-Datenbank, dies würde Ihre Lösung auf eine andere Ebene bringen.

Answer 2

Wie @ YowE3K vorgeschlagen - eine Kopie der Datei machen könnte und es für den Vergleich zu verwenden.

Fügen Sie diesen Code zum ThisWorkbook Modul:

Option Explicit 

Public tmpWrkBk As Workbook 

Private Sub Workbook_Open() 
    Dim FSO As Object, TmpFolder As Object 
    Dim tmpFileName As String 

    Set FSO = CreateObject("Scripting.FileSystemObject") 

    Set TmpFolder = FSO.GetSpecialFolder(2) 'Set reference to the temp folder. 
    tmpFileName = FSO.GetBaseName(ThisWorkbook.Name) & Format(Now(), "dd-mmm-yy hh-mm-ss") 

    'Save this file as a temporary file. 
    ThisWorkbook.SaveCopyAs TmpFolder & Application.PathSeparator & tmpFileName & ".xlsm" 

    'Open and hide the temp workbook. 
    Application.EnableEvents = False 
     Set tmpWrkBk = Workbooks.Open(Filename:=TmpFolder & Application.PathSeparator & tmpFileName & ".xlsm", _ 
      UpdateLinks:=False, ReadOnly:=True) 
     Workbooks(tmpFileName & ".xlsm").Windows(1).Visible = False 
    Application.EnableEvents = True 

    Set FSO = Nothing 

End Sub 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Dim tmpTarget As Range 
    If Not tmpWrkBk Is Nothing Then 
     Application.EnableEvents = False 
     'Set reference to same cell in temp workbook and compare values. 
     Set tmpTarget = tmpWrkBk.Worksheets(Target.Parent.Name).Range(Target.Address) 
     If Target.Value <> tmpTarget Then 
      'Value is different, so change the colour. 
      Target.Interior.Color = RGB(181, 244, 0) 
     Else 
      'Value is the same so change the formatting back again. 
      tmpTarget.Copy 
      Target.PasteSpecial Paste:=xlPasteFormats 
     End If 
     Application.EnableEvents = True 
    End If 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 

    Dim tmpFileName As String 

    'Close and delete the temp file before closing. 
    If Not tmpWrkBk Is Nothing Then 
     tmpFileName = tmpWrkBk.FullName 
     Application.EnableEvents = False 
     tmpWrkBk.Close savechanges:=False 
     Application.EnableEvents = True 
     Application.DisplayAlerts = False 
     Kill tmpFileName 
     Application.DisplayAlerts = True 
    End If 

End Sub 

Edit: Sie werden bemerken, ich Application.EnableEvents gesteckt haben beim Öffnen und die temporäre Datei zu schließen - dies wird von dem Brennen auf die die Workbook_Open und Workbook_Close Ereignisse stoppen temporäre Datei (die zu einer Art Endlosschleife führen würde).