如果用户正在删除，检测工作表上的变化
我想知道如何检测用户是否删除或插入一个范围的内容。 如果他们正在删除范围说D14：D18。 然后，我想要执行一个macros，它也会删除E14：E18中的内容。 我只是不想删除E14：E18，如果他们input内容到D14：D18。
我试过了：
If Selection.ClearContents Then MsgBox Target.Offset(0, 3).Style End If 但是，这让我陷入了一个无限循环。
更多的上下文：
D:D有几百个单元用于input服务数量。 不是所有的D:D都应该被触及。 D:D只有单元格.Style = "UnitInput" 。 在E:E我有数据validation，让用户只能进入contractor 1或contractor 2但是，当在D:Dinput内容时，我运行一个macros将默认承包商（位于F:F ）分配给E:E 。 因此，当用户将数量input到D:D它会正确指定默认承包商。 当他们删除D:D单数项目时，我已经处理了合适的承包商。 只有当他们从D:D删除了一系列的项目。
完整代码：
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False On Error GoTo ErrHandler: If Selection.Rows.Count * Selection.Columns.Count = 1 Then If Target.Offset(0, 3).Style = "Contractor" Then If Target.Value < 1 Then Target.Offset(0, 3).Value = "" Else Target.Offset(0, 3).Value = Target.Offset(0, 2).Value End If End If If Target.Offset(0, 5).Style = "Markup" Then If Target.Value = "" Then Target.Offset(0, 5).Value = "" ElseIf Target.Value <= Target.Offset(0, 14).Value Then Target.Offset(0, 5).Value = "Redact 1" ElseIf Target.Value >= Target.Offset(0, 15).Value Then Target.Offset(0, 5).Value = "Redact 2" Else Target.Offset(0, 5).Value = "Redact 3" End If End If Else '!!!!!! this is where I need to handle multiple deletions. !!!!!!! End If Application.ScreenUpdating = True ErrHandler: Application.ScreenUpdating = True Resume Next End Sub
根据你在聊天中的评论，这是我的build议
UNTESTED
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, aCell As Range Dim lRow As Long '~~> Error handling, Switching off events and Intersect '~~> As described in '~~> http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs On Error GoTo Whoa Application.EnableEvents = False With ActiveSheet '~~> Find Last Row since data is dynamic '~~> For further reading see ' http://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba If Application.WorksheetFunction.CountA(.Cells) <> 0 Then lRow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row End If If lRow > 12 Then '~~> Set your range Set rng = Range("D13:D" & lRow) If Not Intersect(Target, rng) Is Nothing Then For Each aCell In rng If Len(Trim(aCell.Value)) = 0 Then Select Case Target.Offset(0, 3).Style Case "Contractor" '~~> Do Your Stuff Case "Markup" '~~> Do Your Stuff ' '~~> And so on ' End Select End If Next aCell End If End If End With Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub
这是一个想法 – 你必须先select一个区域来清除其内容。 使用select更改logging非空白单元格的数量，然后更改工作表以查看是否降至零。 就像是：
Dim NumVals As Long Private Sub Worksheet_Change(ByVal Target As Range) Dim NewCount As Long NewCount = Application.WorksheetFunction.CountA(Target) If NewCount = 0 And NumVals > 0 Then MsgBox Target.Address & " was cleared" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) NumVals = Application.WorksheetFunction.CountA(Target) End Sub
我有这个代码是Sheet1，它似乎捕获当我突出显示一组单元格（其中至less包含一个值），然后点击删除键。
您可以使用CommandBars撤消控制来确定用户是否实际删除了某些内容。
请记住，如果用户的任何或所有的范围D14:D18的内容，但可以在很多方面进行调整，以满足您的确切需要，这将触发。 看到你的编辑后，这基本上意味着你可以调整范围，需要和E列中的哪些单元格影响。 如果你需要更多的指导，请告诉我。
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("D14:D18")) Is Nothing Then Dim sLastAction As String sLastAction = Application.CommandBars("Standard").Controls("&Undo").List(1) Debug.Print sLastAction 'manual delete 'right-click delete 'backspace delete If sLastAction = "Clear" Or sLastAction = "Delete" Or Left(sLastAction, 9) = "Typing ''" Then Application.EnableEvents = False Me.Range("E14:E18").ClearContents Application.EnableEvents = True End If End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim ChangedRange As Range Dim Area As Range Dim Cell As Range Set ChangedRange = Application.Intersect(Target, Range("D:D")) If Not ChangedRange Is Nothing Then Application.EnableEvents = False For Each Area In ChangedRange.Areas For Each Cell In Area If IsEmpty(Cell) Then Cell.Offset(0, 1).ClearContents End If Next Next Application.EnableEvents = True End If End Sub