BeforeDoubleClick代码根据当前光标所在的位置放置数据

Question

我可能或者可能没有这么简单......出于某种原因，我无法正确地想到解决方案。

电子表格在第A列中有数字1到14.由于单元格A1中有标题，因此第14行在第15行结束。我要做的是双击其中一个数字并将该数字转移到同一张纸上的特定单元格（名为“Sheet1”）。我能够将代码放在一起，使其能够将选定的数字传输到特定的单元格。以下代码效果很好。但是，我不想添加一堆区域来双击不同的单元格。例如：所选数据的目标单元格为E6，H6和G6。我想将光标从E6开始，双击A2到A15范围内的数字，并在A2和A15之间选择该数字出现在E6中，因为那是我双击单元格时光标所在的位置在A2到A15。然后我会通过单击H6移动光标然后返回到A2到A15之间的相同选择，在H6中放置我在该范围内选择的任何数字，因为那是光标当前存在的位置。

希望这是有道理的，甚至是可能的。

示例屏幕截图

允许双击将数据放入某个单元格的工作代码

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:A15")) Is Nothing Then
    Cancel = True
    Target.Copy Destination:=Cells(6, "E")
End If
End Sub

Answer 1

我添加了我想尝试的解决方案，并在代码中添加了注释。 两个工作表变量的原因是因为双击中的第一次单击会注册为SelectionChange事件。因此，要获得正确的单元格位置，您需要从两个选项中获取它，而不是仅仅一个。

Public selectedCell As String 'Sheet Variable
Public lastCell As String

' This updates the Sheet variable with the most recent selection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    selectedCell = lastCell
    lastCell = Target.Address
End Sub

' Added a check for having a previously selected cell
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A2:A15")) Is Nothing Then
        If selectedCell = vbNullString Then
            Cancel = True
            MsgBox "Please select a destination cell for the data."
            selectedCell = vbNullString
            lastCell = vbNullString 'Prevents overwriting same cell by accident
        Else
            Cancel = True
            Target.Copy Destination:=Range(selectedCell)
            selectedCell = vbNullString
            lastCell = vbNullString 'Prevents overwriting same cell by accident
        End If
    End If
End Sub

Answer 2

这是一个很小的工具，您可以根据自己的需要进行调整。如果双击空单元格，它将成为 FinalDestination 。如果您再双击另一个非空的单元格，其内容将被复制到 FinalDestination ：

在工作表代码区：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    Application.EnableEvents = False
        If Target.Value = "" Then
            Set FinalDestination = Target
        Else
            Target.Copy FinalDestination
        End If
    Application.EnableEvents = True
End Sub

在标准模块中：

Public FinalDestination As Range

注意：

在这个简单的演示代码中，源/目标没有限制。