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

但是，请注意，因为如果更改值，可能会进入某个无限循环。

不使用第二个电子表格的想法不是很好，你需要比较一些东西。您可以在VBA中将值保存在公共List或类似内容中，但是一旦电子表格关闭或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事件在临时文件上触发（会导致某种无限循环。）

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

2 个答案: