单独计数细胞变化
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
我有个小问题。我编辑了一个代码来计算所选单元格的单元格更改,实际上效果很好。此代码进入工作表编码,而不是作为 运行 的单独宏。 怎么可能 运行 相同的代码并行计算不同的区域与另一个观察不同单元格的区域分开计数。 我尝试使用 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