修改宏以仅适用于选择，而不是整个工作表答案

【问题标题】：Modifying macro to only apply to selection, not entire sheet修改宏以仅适用于选择，而不是整个工作表
【发布时间】：2016-04-12 19:40:52
【问题描述】：

我有一个宏，它采用一列并且基本上复制每一行：

Sub Duper()
Dim LR As Long
Dim i As Long

LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For i = LR To 1 Step -1
    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown
    Application.CutCopyMode = False
Next i

End Sub

输入

101
102
103
104
105

输出

101
101
102
102
103
103
104
104
105
105

但是，我不能添加新数据，然后只能复制新数据，因为宏适用于整个工作表。

我需要在这个宏中添加什么才能让我只对选定的单元格运行宏？

【问题讨论】：

标签： vba excel

【解决方案1】：

只做选定的单元格：

Sub Duper()

    Dim i As Long

    For i = (Selection.Row + Selection.Rows.Count - 1) To Selection.Row Step -1
        Rows(i).Copy
        Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown
        Application.CutCopyMode = False
    Next i

End Sub

所以选择你想要的单元格，然后运行它。

【讨论】：

【解决方案2】：

建议你使用数组而不是循环（为了速度）：

Sub EddieBetts()
 Dim rng1 As Range
 Dim X, Y
 Dim lngCnt As Long

 Set rng1 = Selection
 X = Application.Transpose(Selection)
 ReDim Y(1 To UBound(X) * 2)
 For lngCnt = 1 To UBound(X)
   Y(2 * lngCnt - 1) = X(lngCnt)
   Y(2 * lngCnt) = X(lngCnt)
 Next
 rng1.Offset(rng1.Rows.Count).Rows.Insert xlDown
 rng1.Resize(rng1.Rows.Count * 2).Value2 = Application.Transpose(Y)
End Sub

【讨论】：