Question

我想知道如何检测用户是否正在删除或插入范围内容。如果他们正在删除范围，请说D14：D18。我想再执行一个也删除E14：E18中内容的宏。如果他们将内容输入D14：D18，我就不想删除E14：E18。

我试过了：

If Selection.ClearContents Then
    MsgBox Target.Offset(0, 3).Style
End If

但这让我陷入无限循环。

更多背景信息：

我在D:D中有几百个单元格用于输入服务数量。不应该触及D:D中的所有内容。只有D:D中.Style = "UnitInput"的单元格。在E:E我有数据验证，只允许用户输入contractor 1或contractor 2但是，当在D:D中输入内容时，我会运行一个宏来指定默认承包商（已安装）在F:F）到E:E。因此，当用户将数量输入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

Answer 1

根据你在聊天中的评论，这是我的建议

<强> 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

Answer 2

这是一个想法 - 您必须先选择一个区域来清除其内容。使用选择更改记录非空白单元格的数量，然后更改工作表以查看它是否降至零。类似的东西：

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，当我突出显示一组单元格（包含至少一个值）然后点击删除键时，它似乎捕获。

Answer 3

您可以使用CommandBars Undo Control来确定用户是否实际删除了某些内容。

请记住，如果用户使用范围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

Answer 4

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

如果用户正在删除，则检测工作表更改

4 个答案: