Excel如果select被削减然后做事情

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

当一行中的一个单元格发生更改，并且具有相同值的另一个表格中的单元格的颜色发生变化时，我已经有了代码。

该代码位于worksheet_Change子项中。

我的问题是如何检测目标是否已被剪切和插入，而不是只input？

编辑**

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

我有2张工作表之一，有一个空行的数据行，然后每个数据组头

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

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

行将永远不会被复制和粘贴，值也不会独立于行。

代码如下

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

有三种潜在的方式，不包括macros来改变一个单元格的值，而不用在单元格中input任何东西：

1. 从工作表上的另一个单元格拖放
2. 从另一个单元格，工作表甚至工作簿复制并粘贴
3. 从另一个单元格，工作表或工作簿中剪切并粘贴

如果您想阻止用户拖放到单元格或单元格区域中，则可以在激活表单时禁用该function。 请确保在停用表单时重新启用它，因为这是一个应用程序设置，适用于所有打开的工作簿中的所有表单。

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

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

为了防止从表格中剪切和粘贴，在单元格select更改时，通过检查CutCopyMode（即，选区周围是否有行进的ant）是否为true，您需要在它发生之前将其捕获。

 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

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

 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