以特定间隔循环复制粘贴

Posted 2023-02-19

【中文标题】以特定间隔循环复制粘贴

【英文标题】：Loop Copy Paste at specific interval

【发布时间】：2016-10-02 22:05:50

【问题描述】：

我是一个初学者，正在尝试运行一个 vba 来做到这一点：

从起点复制公式（单元格 B6） 将此公式每隔 18 行向下粘贴到同一列上 重复该过程，直到单元格显示“报告结束”

我有以下代码，但无法使其正常运行（仅从现有报表继承公式）：

'(a) to set the formula at starting point: 
        Windows("RAVEN MNL adj.xlsm").Activate
        Range("B6").Select
        ActiveCell.FormulaR1C1 = "=TRIM(RIGHT(RC[-1],7))"

'(b) to copy paste in loop 
        Dim i As Long
        Dim ii As Long
        Dim strLastCell As Long
        Dim rng As Range

        Set rng = Range("B:B").Cells

        strLastCell = rng.Find(what:="End of Report", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

        ii = i + 18
        i = ActiveCell.Select

        For ii = i To strLastCell
        Range("B6").Copy
        Range("B" & ii).Paste
        Next ii
        End Sub

错误似乎在“strLastCell”位。你能帮我吗？

【问题讨论】：

i 是一个 Long。您不能将 ActiveCell.Select 分配给 Long 变量。你说你想每 18 行写一次，那么你需要用 For ii = i To strLastCell step 18 将 ii 增加 18@

【参考方案1】：

如果您希望将与 B6 单元格中相同的公式放置在从 B6 到“报告结束”单元格的每 18 个单元格中，请使用：

Sub test()

    Dim i As Long
    Dim ii As Long
    Dim strLastCell As Long
    Dim rng As Range

    Set rng = Range("B:B").Cells

    strLastCell = rng.Find(what:="End of Report", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).ROW

    For ii = 6 To strLastCell Step 18
        Range("B" & ii).FormulaR1C1 = "=TRIM(RIGHT(RC[-1],7))"
    Next ii

End Sub