由于手动更改其他单元格的值更新只有一次

当C50有一些变化时，我想把C49增加0.8。 但我希望它只做一次。 我正在使用下面的代码，但增量继续

Private Sub Worksheet_Change(ByVal Target As Range) dim x as Integer x=0 If Not Intersect(Target, Range("C50")) Is Nothing Then If Not IsEmpty(Cells(49, 3).Value) Then If x = 0 Then Cells(49, 3).Value = Cells(49, 3).Value + 0.8 x = x+1 End If End If End If End Sub 

Answer 1

试试下面的VBA代码：

 Dim PerformChange As Boolean Private Sub Worksheet_Change(ByVal Target As Range) If PerformChange Then If Not ((Intersect(Target, Range("C50")) Is Nothing) Or _ (IsEmpty(Cells(49, 3).Value))) Then PerformChange = False Cells(49, 3).Value = Cells(49, 3).Value + 0.8 End If Else PerformChange = True End If End Sub 

全局布尔值PerformChange用于只允许单个更改，否则recursion调用Change过程。

Answer 2

这是一个办法。 我也禁用/启用了事件并添加了error handling。 你可能想看到这个

逻辑：

第一次写入C49时，将单元格命名为DoNoWriteAgain 。 下一次只要检查单元格是否已经被命名，如果它没有添加;）

码：

 Private Sub Worksheet_Change(ByVal Target As Range) Dim sName As String Dim rRangeCheck As Range On Error GoTo Whoa Application.EnableEvents = False sName = "DoNoWriteAgain" On Error Resume Next Set rRangeCheck = Range(sName) On Error GoTo 0 If rRangeCheck Is Nothing Then If Not Intersect(Target, Range("C50")) Is Nothing Then If Not IsEmpty(Cells(49, 3).Value) Then Cells(49, 3).Value = Cells(49, 3).Value + 0.8 ActiveWorkbook.Names.Add Name:=sName, _ RefersToR1C1:="=" & ActiveSheet.Name & "!R49C3" End If End If End If Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub