《神奇的VBA》编程：监控表格单元格值的变化

该插件充当数据库和Excel界面的连接器实现同步功能以减少工作中对SAP的依赖，为了减少不必要的数据库更新，寻思着用户在操作Excel中数据时监控单元格值，如有变化即用户切切实实地修改了数据再上传同步至数据库中。

监控单元格值的变化在职场报表中有着广泛的场景应用。比如小组讨论生产报表中的数据，修改数据时能自动改变单元格背景色以凸显哪些数据做了变更。

那怎么样监控单元格值的变化呢？

例如：我们需要在日常操作过程中将值发生变化的单元格区域边框设置为红色加粗的外边框。

相信有一定VBA基础的同学们都会想到使用Worksheet的Change事件来监控。

如果您不了解表格事件，可以度娘或者下载安装参阅《神奇的VBA》插件，了解Excel事件的相关知识。

采用工作表的Change事件，见下方VBA代码示例。

    Private Sub Worksheet_Change(ByVal Target As Range)Target.BorderAround ColorIndex:=3, Weight:=xlThickEnd Sub

    但是通过运行我们发现， 该程序看着符合我们的功能需求， 但是深入应用发现有一种特殊情况，依然会触发Worksheet_Change事件。即如果双击进入单元后未改变单元格值的前提下再次退出编辑状态，此时Change事件被触发了。

    很显然，Change事件不能很好的为我所用。那怎么办呢？如何来规避这种情况呢?

    下面我提供三种思路：

    思路1：

    屏蔽单元格双击事件

    采用Worksheet_BeforeDoubleClick事件，禁止鼠标左键双击进去单元格内部的行为。

      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Cancel = TrueEnd Sub

        Private Sub Worksheet_Change(ByVal Target As Range)Target.BorderAround ColorIndex:=3, Weight:=xlThickEnd Sub

        该方法粗暴地禁用了鼠标双击进入内部的行为，对于日常办公操作很不友好。

        思路2：

        通过判断选中单元格前一个单元格值有没有变化。

        弃用Worksheet_Change事件，改为Worksheet_SelectionChange事件。事件所在的工作表模块上方添加了4个全局变量，通过比较全局变量值和单元格区域地址来确定单元格值是否发生变化。

          Dim lastCell As StringDim lastCellValue As StringDim thisCell As StringDim thisCellValue As String
          Private Sub Worksheet_SelectionChange(ByVal Target As Range)If lastCell = "" ThenthisCell = Target.Cells(1).AddresslastCell = Target.Cells(1).AddresslastCellValue = CStr(Target.Cells(1).Value)thisCellValue = CStr(Target.Cells(1).Value)ElselastCell = thisCelllastCellValue = thisCellValuethisCell = Target.AddressthisCellValue = Target.Cells(1).ValueEnd If
          If Range(lastCell).Value <> lastCellValue ThenRange(lastCell).BorderAround ColorIndex:=3, Weight:=xlThickEnd IfthisCell = Target.AddressEnd Sub

          该方法对于一般同学而言已经开始烧脑了！

          通过运行后发现确实符合了我的需求，但也带来了新的问题，即如果我选中的是包含多个单元格的单元格区域就会产生程序运行错误，原因在于示例代码中Target.Value和Range(lastCell).Value取值失败。

          我在Worksheet_SelectionChange过程中添加If Target.Cells.Count > 1 Then Exit Sub，规定鼠标选中单元格区域中只能有一个单元格来规避这种错误。

            Dim lastCell As StringDim lastCellValue As StringDim thisCell As StringDim thisCellValue As String
            Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Cells.Count > 1 Then Exit SubIf lastCell = "" ThenthisCell = Target.Cells(1).AddresslastCell = Target.Cells(1).AddresslastCellValue = CStr(Target.Cells(1).Value)thisCellValue = CStr(Target.Cells(1).Value)ElselastCell = thisCelllastCellValue = thisCellValuethisCell = Target.AddressthisCellValue = Target.Cells(1).ValueEnd If
            If Range(lastCell).Value <> lastCellValue ThenRange(lastCell).BorderAround ColorIndex:=3, Weight:=xlThickEnd IfthisCell = Target.AddressEnd Sub

            然而运行验证时，对多个单元格选区中活动单元格发生值变化时，就不会产生任何作用了。很显然If Target.Cells.Count > 1 Then Exit Sub的运用违背了我的需求初衷。那么对于多单元格的选区目前我想出来的最好的方法就是对Target区域中的第一个单元格值的变化来触发事件，具体见如下代码。

              Dim lastCell As StringDim lastCellValue As StringDim thisCell As StringDim thisCellValue As String
              Private Sub Worksheet_SelectionChange(ByVal Target As Range)If lastCell = "" ThenthisCell = Target.Cells(1).AddresslastCell = Target.Cells(1).AddresslastCellValue = CStr(Target.Cells(1).Value)thisCellValue = CStr(Target.Cells(1).Value)ElselastCell = thisCelllastCellValue = thisCellValuethisCell = Target.AddressthisCellValue = Target.Cells(1).ValueEnd If
              If Range(lastCell).Cells(1).Value <> lastCellValue ThenRange(lastCell).Cells(1).BorderAround ColorIndex:=3, Weight:=xlThickEnd IfEnd Sub

              但这种方法对于单个单元格值的改变还是很有用的。但是我们日常工作，鼠标操作可不可能永远只是一个单元格。

              思路3：

              综合运用上面的2个思路。

              综合采用Worksheet_Change事件和Worksheet_SelectionChange事件，并借助Application.EnableEvents属性有条件地决定执行Change事件还是SelectionChange事件。

                Dim lastCell As StringDim lastCellValue As StringDim thisCell As StringDim thisCellValue As StringPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If lastCell = "" ThenthisCell = Target.Cells(1).AddresslastCell = Target.Cells(1).AddresslastCellValue = CStr(Target.Cells(1).Value)thisCellValue = CStr(Target.Cells(1).Value)ElselastCell = thisCelllastCellValue = thisCellValuethisCell = Target.AddressthisCellValue = Target.Cells(1).ValueEnd If
                If Range(lastCell).Cells(1).Value <> lastCellValue ThenRange(lastCell).Cells(1).BorderAround ColorIndex:=3, Weight:=xlThickEnd IfEnd Sub

                  Private Sub Worksheet_Change(ByVal Target As Range)If Target.Cells.Count > 1 Then Application.EnableEvents = False Target.BorderAround ColorIndex:=3, Weight:=xlThickEnd IfApplication.EnableEvents = TrueEnd Sub

                  通过运行验证， 思路3的代码最终符合了我的需求。这两种工作表事件的综合运用在逻辑上有点绕脑，有兴趣的同学在验证的同时务必有点耐心。

                  验证时，如果发现将外边框设置为红色粗体的边框的设置不利于观察同一个单元格值多次变化的情况。那么我建议将单元格背景色设置为随机色来凸显变化。

                  Range.Interior.ColorIndex = Round(Rnd * 16 + 1, 0)

                    Dim lastCell As StringDim lastCellValue As StringDim thisCell As StringDim thisCellValue As StringPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If lastCell = "" ThenthisCell = Target.Cells(1).AddresslastCell = Target.Cells(1).AddresslastCellValue = CStr(Target.Cells(1).Value)thisCellValue = CStr(Target.Cells(1).Value)ElselastCell = thisCelllastCellValue = thisCellValuethisCell = Target.AddressthisCellValue = Target.Cells(1).ValueEnd If
                    If Range(lastCell).Cells(1).Value <> lastCellValue ThenRange(lastCell).Cells(1).Interior.ColorIndex = Round(Rnd * 16 + 1, 0)End IfEnd 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 IfApplication.EnableEvents = TrueEnd Sub

                      赞 (0)

                      相关推荐