如果值更改，则更改单元格颜色

Question

如果用户在特定工作表上更改为不同的值，我想编写一些 VBA 来更改单元格的颜色。

每个月，用户都会对该月的同一张工作表进行更改。用户将更改某些字段。没有可能发生的变化的列表，因为它可能是任何东西。我们已要求用户突出显示他们是否对 Excel 工作表中的单元格进行了更改。但我想编写一个自动检测的宏。但是，如果他们犯了错误并将单元格恢复为原始值（打开文件的点），则不需要突出显示。

如果值发生变化，我有此代码可以更改单元格的颜色

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

End Sub

但是如果值变回原来的值，我该如何变回无颜色呢？

提前非常感谢。

Answer 1

这里有一些你可以使用的东西：

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

一旦创建，它将值设置为第三张表，然后检查它是否已更改。 IsEmpty(rngCell) 是支票。

编辑：关于格式的问题

如果您愿意，请尝试在某处实现以下内容：

Private Sub CopyFromAtoB(rngA As Range, rngB As Range)
    
    rngB.Value = rngA.Value
    rngA.Copy
    rngB.PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False
    
End Sub

但是，请小心，因为如果更改值，您可能会在某处进入无限循环。

不使用第二个电子表格的想法不是一个好主意，您需要一些可以比较的东西。您可以将值保存在公共 List 或 VBA 中的类似内容中，但是一旦电子表格关闭或 VBA 代码被破坏，您将失去一切。这是痛苦的。因此，这不是我推荐的。

如果您想让它非常专业地使用 SQL 数据库，这将使您的解决方案更上一层楼。

Answer 2

正如@YowE3K 所建议的那样 - 您可以复制该文件并将其用于比较。

将此代码添加到ThisWorkbook 模块：

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

编辑：您会注意到我在打开和关闭临时文件时输入了 Application.EnableEvents - 这将阻止 Workbook_Open 和 Workbook_Close 事件在临时文件上触发（这会导致某种无限循环）。