Excel 由于其他单元格中的更改，只能手动更新一次单元格值

当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

---

请尝试以下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

仅用于允许单个更改，否则将递归调用

Change

过程。

这里有一种方法。我还禁用/启用了事件，并添加了错误处理。你可能想看看

逻辑：

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

第一次写入C49时，将单元格命名为

donowrite

。下次只需检查单元格是否已命名，如果已命名，则不添加；）

代码：

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

---

在这种情况下，全局变量不是解决方案，因为有两个原因

1

如果代码中断，变量将被重置<代码>2如果工作簿已保存并关闭，则变量将被重置。@SiddharthRout：（1）代码不应中断。如果它发生了，你很可能会修复它，直到它不坏为止，从这一点上来说，这并不重要。（2） 将更新

PerformChange=True

添加到工作簿的

Open

过程。即使将activex控件添加到工作表中，全局变量也将重置。如果一个代码在除上述代码以外的任何地方中断，该变量仍将被重置：）因此

您很可能会修复它，直到它不中断

这实际上没有帮助：）顺便说一句，上面的变量

PerformChange

不是

全局

。全局变量不是使用模块中的

Dim

声明的，而是使用模块中的

Public

声明的。：）