Question

如果之前已经回答过，请道歉，但事件处理对我来说仍然很新。

我正在尝试实现的是双击一个单元格将其剪切到剪贴板，然后当我单击一个新单元格以便在该点插入剪切单元格时，将现有单元格向下移动。

用于切割单元格的双击位很容易：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Cancel = True
    Target.Cut

End Sub

...但其余部分对我来说并不明显，因为它需要在事件中调用另一个事件（我正在假设的SelectionChange）。

这是如何实现的？我做了一些搜索 - 我确信它会很明显 - 但我可能没有找到正确的条款。

提前致谢。

编辑：非常感谢你的回答。

作为备受欢迎的后续问题 - 使用抓取边框方法拖动单元格时有一种方法可以完成同样的事情：即拖动和插入单元格而不是调用“你做想要取代“对话？我知道这可以通过按住Shift键来完成 - 但我正在寻找一种方法来编写工作表，以便拖放的单元格将自动插入而不是覆盖。

Answer 1

这个怎么样？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Cancel = True
    Target.Cut

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Application.CutCopyMode = xlCut Then
        Target.Insert Shift:=xlDown
        Application.CutCopyMode = False
    End If

End Sub

更新

单元格没有拖动事件，但基于此链接的{hacky变通方法http://www.mrexcel.com/forum/excel-questions/284788-challenging-post-override-cell-drag-drop-behavior-2.html

这实际上允许拖动，然后应用UNDO来查找目标和目标单元格。我做的唯一补充就是添加Application.AlertBeforeOverwriting来禁用覆盖消息。

Dim trigger As Boolean
Dim flag As Boolean
Dim busy As Boolean
Const overwriteAlert As Boolean = False


Private Sub Worksheet_Change(ByVal Target As Range)

    With Target
        If .Count = 1 And trigger Then
            If flag Then
            If busy Then Exit Sub
            busy = True
            Call MyDrag
            flag = False
            Else
            flag = True
            End If
        End If
    End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    flag = False
    busy = False
    trigger = Target.Count = 1
    Application.AlertBeforeOverwriting = overwriteAlert

End Sub

Sub MyDrag()
Dim DragAddress As String
Dim DropAddress As String

    With Application
    .EnableEvents = False
    .ScreenUpdating = False

    DropAddress = ActiveCell.Address
    .Undo
    DragAddress = ActiveCell.Address

        If Range(DropAddress).Column = Range(DragAddress).Column Then
        .Undo
        Else

            With Range(DropAddress)
            .Activate
            .Insert Shift:=xlDown
            .Offset(-1) = Range(DragAddress)
            End With

        Range(DragAddress).Delete Shift:=xlUp
        End If

    .ScreenUpdating = True
    .EnableEvents = True
    End With

'busy = False

End Sub

双击剪切，然后在单击新单元格时插入+ shift，

1 个答案: