单独计数细胞变化

Count cell change individually

我有个小问题。我编辑了一个代码来计算所选单元格的单元格更改,实际上效果很好。此代码进入工作表编码,而不是作为 运行 的单独宏。 怎么可能 运行 相同的代码并行计算不同的区域与另一个观察不同单元格的区域分开计数。 我尝试使用 double IF 什么给了我一个错误,我在不同的子下尝试了相同的代码。

目前监视 C8 单元格变化的代码在 D8 中计数。 我需要 运行 C16 的另一个计数器并在 D18 中计数。 如果我需要用单独的计数器监控多个单元,我该怎么做?

    Dim xCount As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If Target = Range("C8") Then
        xCount = xCount + 1
        Range("D8").Value = xCount
    End If
    Application.EnableEvents = False
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("C8"))
    If Not xRg Is Nothing Then
        xCount = xCount + 1
        Range("D8").Value = xCount
    End If
    Application.EnableEvents = True
End Sub

已编辑:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim xRg As Range, xCell As Range, ranges, x As Long
    Dim deps As Range

    If Target.Count > 1 Then Exit Sub '<<<<<<<< added this...

    On Error GoTo haveError

    ranges = Array("C8", "C16")

    For x = 0 To UBound(ranges)

        Set xCell = Range(ranges(x))

        If Not Application.Intersect(Target, xCell) Is Nothing Then
            Application.EnableEvents = False
            xCell.Offset(0, 1).Value = xCell.Offset(0, 1).Value + 1
        End If

        Set deps = Nothing
        On Error Resume Next         'suspend error trapping
        Set deps = Target.Dependents
        On Error GoTo haveError      'resume trapping

        If Not deps Is Nothing Then
            Set xRg = Application.Intersect(Target.Dependents, xCell)
            If Not xRg Is Nothing Then
                Application.EnableEvents = False
                xCell.Offset(0, 1).Value = xCell.Offset(0, 1).Value + 1
            End If
        End If
    Next x

haveError:
    Application.EnableEvents = True

End Sub