Question

我有一个工作簿，需要在剪切和插入的行上运行宏

我已经有一些代码在一行中的一个单元格发生变化时运行，这会改变另一个单元格中具有相同值的单元格的颜色。

该代码位于workheet_Change sub。

中

我的问题是如何检测目标是否已被切割和插入而不是仅仅输入？

编辑**

感谢Mark Fitzgerald我意识到我需要提供更多信息。

我有两张纸，其中一行有数据行，一行是空行，然后是每组数据的标题

另一个工作表是按列设置的，因此每个列都有标题信息，然后是该组中每个行的第一个单元格。

当有人剪切并从行表中的一个组中插入一些行时，列表中的相关单元格将移动到相关列。

不会复制和粘贴行，也不会独立于行移动值。

以下代码

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim KeyCells As Range
Dim batchNo
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("m1:m5000")
Set batchNo = Range("A" & ActiveCell.Row)

If Target.count = 1 Then
    Select Case Target.Value
        Case "x"

        Case "y"

        Case Else
            ActiveCell.Interior.Color = RGB(255, 255, 255)
            ActiveCell.Font.Color = RGB(0, 0, 0)
    End Select

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        Dim c
        With Sheets("columnsheet").Range("d12:fz144")
            Set c = .Find(batchNo, LookIn:=xlValues)
            If Not c Is Nothing Then
                Workbooks("Work In Process.xls").Activate
                Worksheets("columnsheet").Activate
                ActiveSheet.Range(c.Address).Activate
                Select Case Target.Value
                Case "x"

                Case "y"

                Case Else
                    ActiveCell.Interior.Color = RGB(255, 255, 255)
                    ActiveCell.Font.Color = RGB(0, 0, 0)
                End Select
                Workbooks("Work In Process.xls").Activate
                Worksheets("rowsheet").Activate
            End If
        End With
    End If
ElseIf (Target.count > 1) Then
                                      'if entire row or rows are selected
End If
Application.ScreenUpdating = True
End Sub

我删除了大部分案例，因为它们使它更混乱，但他们所做的只是更改文字颜色和背景颜色

Answer 1

有三种可能的方法（不包括宏）来更改单元格值而不在单元格中实际输入任何内容：

从工作表上的其他单元格拖放
从其他单元格，工作表甚至工作簿中复制并粘贴
从其他单元格，工作表或工作簿中剪切和粘贴

如果要阻止用户拖放到单元格或单元格区域中，则可以在激活工作表时禁用该功能。取消激活工作表时务必重新启用它，因为它是适用于所有打开的工作簿中所有工作表的应用程序设置。

Private Sub Worksheet_Activate()
    Application.CellDragAndDrop = False
End Sub

Private Sub Worksheet_Deactivate()
    Application.CellDragAndDrop = True
End Sub

当您将鼠标悬停在非空白单元格边框上时，您会注意到鼠标指针不会更改为4个箭头。我发现了一个无证的副作用，如果你试图从另一个工作表或工作簿中复制某些东西，禁用CellDragAndDrop也会清除剪贴板。

为了防止在工作表内进行剪切和粘贴，您需要通过检查CutCopyMode（即选择周围是否存在行进蚂蚁）在单元格选择发生变化时是否为真来捕获它。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.CutCopyMode <> False Then
        Application.CutCopyMode = False
        MsgBox "Cut or Copy & Paste is not allowed on this sheet", vbExclamation
    End If
End Sub

Answer 2

我解决这个问题的方法是检查选择是否是一整行

If Target.count > 0 Then
    Dim r As Range
    If Target.Columns.count = ActiveSheet.Columns.count Then        ' if entire row
        If Target.rows.count > 1 Then                               ' multiple rows
            For Each r In Target.rows                               
                DoStuff r
            Next r
        Else                                                        'single row
            DoStuff Target
        End If
    ElseIf Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        If Target.rows.count > 1 Then                               ' multiple items
            For Each r In Target.rows                               ' do stuff for each item
                DoOtherStuff r
            Next r
        Else                                                        'single item
            DoOtherStuff Target
        End If
    End If
End If

Excel如果选择被删除则执行

2 个答案: