VBA：知道如何记住最初选择的单元格以在代码之后将选择复制到它

如何解决VBA：知道如何记住最初选择的单元格以在代码之后将选择复制到它

嗨，我需要一些帮助。我想选择单元格列并仅提取唯一值并将所有结果缩小到 1 列。除了我希望将其粘贴到我选择的原始单元格的部分之外，代码工作正常。我试过设置 cell = activecell。但是，在最后的所有代码都说“范围类的运行时错误 1004 切割方法失败”之后返回它时，我不断收到错误消息。谢谢我真的很感谢您为此提供的帮助。

Sub Super_PasteInto1Col()

'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+m
'

Dim i As Integer
Dim icolumns As Long
Dim columns As Long
Dim rselection As Range
Dim EntireColumn As Range
Dim cell As Range

Set cell = ActiveCell
Application.Goto ActiveCell.EntireColumn.End(xlUp)
Selection.PasteSpecial Paste:=xlPasteValues

Set rselection = Selection
For i = 1 To rselection.columns.Count
Selection.columns(i).RemoveDuplicates columns:=1,Header:=xlGuess
Selection.columns(i).sortSpecial (xlPinYin)
Next i


icolumns = rselection.columns.Count - 1
For i = 1 To icolumns
Application.Goto rselection.columns(i + 1).End(xlUp)
Set EntireColumn = Selection.EntireColumn

If Application.WorksheetFunction.CountA(EntireColumn) = 1 Then

    If Application.WorksheetFunction.CountA(rselection.columns(1)) = 1 Then
    Selection.Cut rselection.columns(1).End(xlUp).Offset(1,0)
    
    Else
    Selection.Cut rselection.columns(1).End(xlDown).Offset(1,0)
    End If

ElseIf Application.WorksheetFunction.CountA(EntireColumn) = 0 Then
Application.Goto Selection


Else
Application.Goto Range(Selection,Selection.End(xlDown))

    If Application.WorksheetFunction.CountA(rselection.columns(1)) = 1 Then
    Selection.Cut rselection.columns(1).End(xlUp).Offset(1,0)
    
    End If
End If

Next i


Application.Goto rselection.columns(1).EntireColumn
Selection.RemoveDuplicates columns:=1,Header:=xlNo
Selection.sortSpecial (xlPinYin)
Application.Goto Selection.End(xlUp)
Application.Goto Range(Selection,Selection.End(xlDown))
Selection.Cut cell


Exit Sub



End Sub

解决方法

很难说出你的意图，但以下是我最好的解释。请尝试一下。

Option Explicit

Sub Super_PasteInto1Col()
    ' 153
    ' Keyboard Shortcut: Ctrl+m

    ' TgtClm is the column where the results are deposited
    Const TgtClm        As Long = 18        ' change to suit
    
    Dim SelRng          As Range            ' range selected by the user
    Dim Clm             As Long             ' first column of SelRng
    Dim C               As Long             ' loop counter: Columns
    Dim Rt              As Long             ' target row
    
    Set SelRng = Selection
    Clm = SelRng.Column
    
    Application.ScreenUpdating = False
    With Columns(Clm)
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With

    For C = 0 To (SelRng.Columns.Count - 1)
        ' start the range in row 2 (leave headers untouched)
        With Range(Cells(2,Clm + C),Cells(Rows.Count,Clm + C).End(xlUp))
            ' this range will start in row 1 if the column is otherwise blank
            If .Row > 1 Then
                .RemoveDuplicates Columns:=1,Header:=xlNo
                .SortSpecial (xlPinYin)
                
                If WorksheetFunction.CountA(Range(.Address)) Then
                    .Cut Cells(Rows.Count,TgtClm).End(xlUp).Offset(1)
                End If
            End If
            Columns(Clm + C).ClearContents
        End With
    Next C

    With Application
        .CutCopyMode = False
        .ScreenUpdating = False
    End With
End Sub

在我的测试中，我为第 1 行中的列添加了标题。我选择了许多这样的标题。第一个具有特殊意义，因为该列中的公式将被它们生成的值替换。之后，选择的每一列都被排序，在删除重复项后，剩余部分（如果有）粘贴到第 18 列（在代码顶部更改）。该列已清除。

我不明白你为什么要回到原来的选择。但是，Selection 对象是在最开始时记录的并且从未更改。因此，它可以满足您的任何想法。