1

抱歉，如果之前已经回答过这个问题，但事件处理对我来说仍然很新。

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

剪切单元格的双击位非常简单：

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

    Cancel = True
    Target.Cut

End Sub

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

这是如何实现的？我已经进行了一些搜索——我相信这将是显而易见的——但我可能没有按照正确的条件进行搜索。

提前致谢。

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

作为一直流行的后续问题 - 是否有办法在使用抓取边框方法拖动单元格时完成相同的事情：即拖动和插入单元格而不是调用“你想替换“对话？我知道这可以通过按住 Shift 键来完成——但我正在寻找一种对工作表进行编码的方法，以便拖放的单元格将自动插入而不是覆盖。

4

1 回答 1

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
于 2013-08-10T23:32:04.547 回答