Question

在Excel中使用VBA时，当活动/选定单元格不同时，有没有办法获取复制单元格的地址？在运行宏之前，将复制单元格。

例如，假设单元格R1当前已被复制，但所选单元格和视图（我在屏幕上看到的内容）位于ZAA列的某个位置。举个简单的例子，我想基本上缩放到复制单元格的区域，而不必手动滚动查找它。

Answer 1

首先，我只想说所有解决方案都非常糟糕。

我认为最好的“hacky”方法可能有很多边缘情况，但我只是抓住CTRL+C和CTRL+X（剪切和复制快捷方式）并用它们做事。 / p>

这不适用于上下文菜单剪切和复制方法 - 有很多方法可以尝试获取它们，但是它们有错误（如果你复制一件事然后复制另一件事而不重置{{1}则主要是错误}）我不确定当一个旧的切割/副本当前处于活动状态时是否有办法检测到“新”切割/复制（你肯定不能通过检查CutCopyMode来完成此操作。）

关于这种方法的另一个（可能？）好处是它实际上遵循你粘贴它时切割的范围...所以如果再次跳跃，你会看到它被移动到的位置（注意如果切割和粘贴到新表，这不起作用。）

在工作簿对象中：

Application.CutCopyMode

在一个模块中：

Private Sub Workbook_Open()
Application.OnKey "^c", "CopyFired"
Application.OnKey "^x", "CutFired"
End Sub

如果Dim CutCopyRange As Range Sub CopyFired() Set CutCopyRange = Selection Selection.Copy End Sub Sub CutFired() Set CutCopyRange = Selection Selection.Cut End Sub Sub JumpToRange() 'You can add CutCopyRange.Parent.Select if you switch worksheets 'But this will not follow a cut->paste from one sheet to another properly 'The Range seems to update itself, but not its parent. If Not CutCopyRange Is Nothing Then CutCopyRange.Select End Sub为假，您可能还需要设置Worksheet_Change次捕获以清除CutCopyRange，但我不会搞砸所有这些。如果他们使用Application.CutCopyMode进行复制并CTRL+C进行裁剪，您应该可以通过简单地捕捉印刷机来捕获它。

请注意，如果您尝试在工作表上剪切/复制对象，则此代码可能还有错误。

调用CTRL+X跳转到当前范围 - 如果它位于不同的工作表上，您可能需要先选择工作表 - 可能还有一些与此相关的其他代码。

我认为您也可以使用JumpToRange代替ScrollTo，但我认为这是经销商的选择。

Answer 2

这是我多年来一直使用的简化代码版本，我认为它可以可靠地运行。无论复制是通过Ctrl+C还是Ctrl+Insert还是通过右键单击上下文菜单或功能区完成的，它都会返回复制的范围（如果有）。

Public Function GetCopiedRange()
    Dim Cell1 As Range
    Dim Cell2 As Range
    Dim ConvexHull As Range
    Dim CopyOfErr As String
    Dim Format As Variant
    Dim Formats As Variant
    Dim Formula1 As String
    Dim Formula2 As String
    Dim SU As Boolean
    Dim tempBook As Excel.Workbook
    Dim TempRange As Range

    On Error GoTo ErrHandler

    If Application.CutCopyMode <> xlCopy Then
        Err.Raise vbObjectError + 1, , "#No copied Range found!"
        Exit Function
    End If
    'Examine ClipBoard formats to check that what's copied is indeed a range
    'Found this tip at http://www.ozgrid.com/forum/showthread.php?t=66773
    Formats = Application.ClipboardFormats
    For Each Format In Formats
        If Format = xlClipboardFormatCSV Then
            GoTo Continue
        End If
    Next
    Err.Raise vbObjectError + 1, , "#No copied Range found!"
    Exit Function
Continue:
    SU = Application.ScreenUpdating
    If SU Then Application.ScreenUpdating = False
    Set tempBook = Application.Workbooks.Add
    tempBook.Worksheets(1).Paste Link:=True
    Set TempRange = Selection

    With TempRange
        Formula1 = .Cells(1, 1).Formula
        Formula2 = .Cells(.Rows.Count, .Columns.Count).Formula
    End With

    'Rubberduck (2.4.1.4627) incorrectly flags these three lines as implicitly referencing the active sheet
    Set Cell1 = Range(Right$(Formula1, Len(Formula1) - 1))
    Set Cell2 = Range(Right$(Formula2, Len(Formula2) - 1))
    Set ConvexHull = Range(Cell1, Cell2)
    'https://en.wikipedia.org/wiki/Convex_hull

    If ConvexHull.Cells.CountLarge = TempRange.Cells.CountLarge Then
        ' Copied Range had one area only.
        Set GetCopiedRange = ConvexHull
    Else
        'There are now two possibilities:
        'a) Copied range had multiple areas, each of the same width and all aligned vertically; or
        'b) Copied range had multiple areas, each of the same height and all aligned horizontally.
        ' It is not possible to copy other layouts of multiple-area ranges (as of Office 2013)
        ' Coping with cases a) and b) is possible but complex, so just raise an error.
        Err.Raise vbObjectError + 1, , "Copied Range has multiple areas"
    End If
    tempBook.Close False
    If SU Then Application.ScreenUpdating = True

    Exit Function
ErrHandler:
    CopyOfErr = Err.Description
    If Not tempBook Is Nothing Then tempBook.Close False
    If SU Then Application.ScreenUpdating = True
    Err.Raise vbObjectError + 1, , CopyOfErr
End Function

Excel VBA - 当活动/选定单元格不同时获取复制的单元格地址

2 个答案: