【问题标题】:How do I execute instructions only if the cell value change?仅当单元格值更改时如何执行指令?
【发布时间】:2021-02-14 00:57:40
【问题描述】:

我有一个 ByVal 代码来清除表格内特定范围的内容,它可以工作。但是我需要为指令执行添加一个条件

另外,有人知道如何在 VBA 中引用表格列?现在我使用的是估计范围“C1:C999”,但我想使用他的名字“A_[OPERATION]”。

这是代码:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   If Not Application.Intersect(Range("C1:C999"), Range(Target.Address)) Is Nothing Then
    
       Range(Selection, Selection.End(xlToRight)).ClearContents

   End If

End Sub

【问题讨论】:

    标签: excel vba byval


    【解决方案1】:

    您可以改用更改事件。

    这是文档的链接: https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.change

    或者,您可以将目标单元格的值保存在一个变量中,并在执行您的清除内容之前检查该值是否发生了变化。

    对于您的第二个问题,您可能应该在单独的帖子中询问。

    【讨论】:

      【解决方案2】:

      工作表更改

      • 调整表名(tName)和表头(列)名(hName)。
      • 我已对其进行了调整,以清除列后单元格中的内容。
      • 如果你确实也需要清空该列的内容,那就把cel.Offset(, 1)换成cel吧。
      • 在表格中,如果手动或通过 VBA 更改了列中的值,当前设置将自动清除指定列右侧所有单元格的内容。如果列包含公式,这将不起作用。也支持非连续删除。

      代码

      Option Explicit
      
      Private Sub Worksheet_Change(ByVal Target As Range)
          
          Const ProcName As String = "Worksheet_Change"
          On Error GoTo clearError
          
          Const tName As String = "A_"
          Const hName As String = "OPERATION"
          
          Dim rng As Range
          Set rng = Range(tName & "[" & hName & "]")
          Set rng = Intersect(rng, Target)
          If rng Is Nothing Then GoTo ProcExit
          
          Application.EnableEvents = False
          
          With ListObjects(tName).HeaderRowRange
              Dim LastColumn As Long
              LastColumn = .Columns(.Columns.Count).Column
          End With
          Dim cel As Range
          For Each rng In rng.Areas
              For Each cel In rng.Cells
                  With cel.Offset(, 1)
                      .Resize(, LastColumn - .Column + 1).ClearContents
                  End With
              Next cel
          Next rng
      
      CleanExit:
          Application.EnableEvents = True
          GoTo ProcExit
      
      clearError:
          Debug.Print "'" & ProcName & "': " & vbLf _
                    & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
                    & "        " & Err.Description
          On Error GoTo 0
          GoTo CleanExit
      
      ProcExit:
      
      End Sub
      

      【讨论】:

        【解决方案3】:

        Worksheet_Change 事件句柄捕获单元格值的变化。

        但是,即使是错误更改,此句柄也会触发。例如,如果更改前的单元格值为“A”,而用户刚刚在该单元格中再次输入“A”,则无论如何都会触发更改事件过程。

        为避免这种情况,我们可以同时使用Worksheet_ChangeWorksheet_SelectionChange

        使用Worksheet_SelectionChange,我们在某处记录旧值,例如Name。然后使用Worksheet_Change,我们可以将用户输入的内容与Name 进行比较,看看是否进行了真正的更改。

        Private Sub Worksheet_SelectionChange(ByVal Target As Range)
            Dim Nm As Name: Set Nm = ActiveWorkbook.Names("OldValue")
            If Target.Count = 1 Then
                'This only record one old cell value.
                'To record multiple cells old value, use a hidden Worksheet to do so instead of a Name.
                Nm.Comment = Target.Value2
            else
                Nm.Comment = Target.Value2(1, 1)
            End If
        End Sub
        
        Private Sub Worksheet_Change(ByVal Target As Range)
            Dim Nm As Name: Set Nm = ActiveWorkbook.Names("OldValue")
            If Target.Value2 <> Nm.Comment Then
                Debug.Print "True change"
            Else
                Debug.Print "False change"
            End If
        End Sub
        

        您可以通过listobject 对象访问表的方法和属性。以下是如何执行此操作的示例。

        Sub Example()
            Dim lo As ListObject
            Dim lc As ListColumn
            Set lo = Range("Table1").ListObject
            Set lc = lo.ListColumns("Column2")
        End Sub
        

        也就是说,对于您的情况,应该是 Range("A_").ListObject.ListColumns("OPERATION").DataBodyRange

        【讨论】:

          猜你喜欢
          • 2019-04-09
          • 1970-01-01
          • 1970-01-01
          • 1970-01-01
          • 2016-05-25
          • 1970-01-01
          • 2020-01-30
          • 1970-01-01
          • 1970-01-01
          相关资源
          最近更新 更多