最近工作太忙加之精力有限，所以一直没花时间亲自更新号子，今天抽空分享一个监控工作表单元格值发生变化的事件程序。本次分享源于我今年年初疫情期间在家开发的一款基于MS Excel名称为Project PO Management的办公插件的思考，该插件充当数据库和Excel界面的连接器实现同步功能以减少工作中对SAP的依赖，为了减少不必要的数据库更新，寻思着用户在操作Excel中数据时监控单元格值，如有变化即用户切切实实地修改了数据再上传同步至数据库中。
Project PO Management
监控单元格值的变化在职场报表中有着广泛的场景应用。比如小组讨论生产报表中的数据，修改数据时能自动改变单元格背景色以凸显哪些数据做了变更。
那怎么样监控单元格值的变化呢？
例如：我们需要在日常操作过程中将值发生变化的单元格区域边框设置为红色加粗的外边框。
神奇的VBA
相信有一定VBA基础的同学们都会想到使用Worksheet的Change事件来监控。
如果您不了解表格事件，可以度娘或者下载安装参阅《神奇的VBA》插件，了解Excel事件的相关知识。
采用工作表的Change事件，见下方VBA代码示例。
Private Sub Worksheet_Change(ByVal Target As Range)
Target.BorderAround ColorIndex:=3, Weight:=xlThick
End Sub
但是通过运行我们发现， 该程序看着符合我们的功能需求， 但是深入应用发现有一种特殊情况，依然会触发Worksheet_Change事件。即如果双击进入单元后未改变单元格值的前提下再次退出编辑状态，此时Change事件被触发了。
很显然，Change事件不能很好的为我所用。 那怎么办呢？如何来规避这种情况呢?
下面我提供三种思路：
思路1：屏蔽单元格双击事件
采用Worksheet_BeforeDoubleClick事件，禁止鼠标左键双击进去单元格内部的行为。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Target.BorderAround ColorIndex:=3, Weight:=xlThick
End Sub
该方法粗暴地禁用了鼠标双击进入内部的行为，对于日常办公操作很不友好。
思路2：通过判断选中单元格前一个单元格值有没有变化。
弃用Worksheet_Change事件，改为Worksheet_SelectionChange事件。事件所在的工作表模块上方添加了4个全局变量，通过比较全局变量值和单元格区域地址来确定单元格值是否发生变化。
Dim lastCell As String
Dim lastCellValue As String
Dim thisCell As String
Dim thisCellValue As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If lastCell = "" Then
thisCell = Target.Cells(1).Address
lastCell = Target.Cells(1).Address
lastCellValue = CStr(Target.Cells(1).Value)
thisCellValue = CStr(Target.Cells(1).Value)
Else
lastCell = thisCell
lastCellValue = thisCellValue
thisCell = Target.Address
thisCellValue = Target.Cells(1).Value
End If
If Range(lastCell).Value <> lastCellValue Then
Range(lastCell).BorderAround ColorIndex:=3, Weight:=xlThick
End If
thisCell = Target.Address
End Sub
该方法对于一般同学而言已经开始烧脑了！通过运行后发现确实符合了我们的需求，但也带来了新的问题，即如果我们选中的是包含多个单元格的单元格区域就会产生程序运行错误，原因在于示例代码中Target.Value和Range(lastCell).Value取值失败。
我们可以在Worksheet_SelectionChange过程中添加If Target.Cells.Count > 1 Then Exit Sub，规定鼠标选中单元格区域中只能有一个单元格来规避这种错误。
Dim lastCell As String
Dim lastCellValue As String
Dim thisCell As String
Dim thisCellValue As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If lastCell = "" Then
thisCell = Target.Cells(1).Address
lastCell = Target.Cells(1).Address
lastCellValue = CStr(Target.Cells(1).Value)
thisCellValue = CStr(Target.Cells(1).Value)
Else
lastCell = thisCell
lastCellValue = thisCellValue
thisCell = Target.Address
thisCellValue = Target.Cells(1).Value
End If
If Range(lastCell).Value <> lastCellValue Then
Range(lastCell).BorderAround ColorIndex:=3, Weight:=xlThick
End If
thisCell = Target.Address
End Sub
然而运行验证时，对多个单元格选区中活动单元格发生值变化时，就不会产生任何作用了。很显然If Target.Cells.Count > 1 Then Exit Sub的运用违背了我们需求初衷。那么对于多单元格的选区目前我想出来的最好的方法就是对Target区域中的第一个单元格值的变化来触发事件，具体见如下代码。
Dim lastCell As String
Dim lastCellValue As String
Dim thisCell As String
Dim thisCellValue As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If lastCell = "" Then
thisCell = Target.Cells(1).Address
lastCell = Target.Cells(1).Address
lastCellValue = CStr(Target.Cells(1).Value)
thisCellValue = CStr(Target.Cells(1).Value)
Else
lastCell = thisCell
lastCellValue = thisCellValue
thisCell = Target.Address
thisCellValue = Target.Cells(1).Value
End If
If Range(lastCell).Cells(1).Value <> lastCellValue Then
Range(lastCell).Cells(1).BorderAround ColorIndex:=3, Weight:=xlThick
End If
End Sub
但这种方法对于单个单元格值的改变还是很有用的。但是我们日常工作，鼠标操作可不可能永远只是一个单元格。
思路3： 综合运用上面的2个思路。
综合采用Worksheet_Change事件和Worksheet_SelectionChange事件，并借助Application.EnableEvents属性有条件地决定执行Change事件还是SelectionChange事件。
Dim lastCell As String
Dim lastCellValue As String
Dim thisCell As String
Dim thisCellValue As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If lastCell = "" Then
thisCell = Target.Cells(1).Address
lastCell = Target.Cells(1).Address
lastCellValue = CStr(Target.Cells(1).Value)
thisCellValue = CStr(Target.Cells(1).Value)
Else
lastCell = thisCell
lastCellValue = thisCellValue
thisCell = Target.Address
thisCellValue = Target.Cells(1).Value
End If
If Range(lastCell).Cells(1).Value <> lastCellValue Then
Range(lastCell).Cells(1).BorderAround ColorIndex:=3, Weight:=xlThick
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Target.BorderAround ColorIndex:=3, Weight:=xlThick
End If
Application.EnableEvents = True
End Sub
通过运行验证， 思路3的代码最终符合了我的需求。这两种工作表事件的综合运用在逻辑上有点绕脑，有兴趣的同学在验证的同时务必有点耐心。
验证时，如果发现将外边框设置为红色粗体的边框的设置不利于观察同一个单元格值多次变化的情况。那么我建议将单元格背景色设置为随机色来凸显变化。
Range.Interior.ColorIndex = Round(Rnd * 16 + 1, 0)
神奇的VBA
Dim lastCell As String
Dim lastCellValue As String
Dim thisCell As String
Dim thisCellValue As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If lastCell = "" Then
thisCell = Target.Cells(1).Address
lastCell = Target.Cells(1).Address
lastCellValue = CStr(Target.Cells(1).Value)
thisCellValue = CStr(Target.Cells(1).Value)
Else
lastCell = thisCell
lastCellValue = thisCellValue
thisCell = Target.Address
thisCellValue = Target.Cells(1).Value
End If
If Range(lastCell).Cells(1).Value <> lastCellValue Then
Range(lastCell).Cells(1).Interior.ColorIndex = Round(Rnd * 16 + 1, 0)
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Target.Interior.ColorIndex = Round(Rnd * 16 + 1, 0)
End If
Application.EnableEvents = True
End Sub
好了，今天的分享就到这里。 对于今天的主题，如果您有更好的思路，欢迎关注并留言！
如果对您有用，请点赞关注并保留好这个模板代码，或者安装《神奇的VBA》插件， 该代码将收录进《神奇的VBA》插件示例代码库中供用户参考！
