Question

当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用于仅允许单个更改，否则递归调用Change过程。

Answer 2

这是一种方法。我还禁用/启用了事件并添加了错误处理。您可能希望看到THIS

<强>逻辑：

第一次写入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

单元值更新由于其他单元格仅手动更改一次

2 个答案: