循环复制以特定间隔粘贴

时间:2016-06-03 00:37:07

标签: excel vba loops

我是初学者,并尝试运行一个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”位。你能帮我吗?

1 个答案:

答案 0 :(得分:0)

如果您希望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