在VBA中创建动态范围

时间:2013-02-10 16:15:27

标签: vba

显然,我的代码还没有必要的循环,但我想从第3行创建一个Range(“b3:gs3”)的循环,并以下面的递归方式更新它:

Range("b3:gs3")
Range("b6:gs6")
Range("b9:gs9")
.
.
.
Range("b720:gs720")

我可以对循环进行编码,但是在编码范围值的这个变化时遇到了困难。

非常感谢帮助。

罗恩

Sub Box()

    Dim curCell3 As Range

    For Each curCell3 In Sheets("Sheet 2").Range("b3:gs3").Cells  'This is the problem

    ActiveWorkbook.Sheets("6").Activate
    Range("B1").Select

    Do While ActiveCell.Value <> curCell3.Value
        ActiveCell.Offset(0, 1).Select
    Loop

            ActiveCell.Offset(44, 0).Select
            ActiveCell.Copy
            ActiveWorkbook.Sheets("Sheet 2").Activate
            curCell3.Select
            ActiveCell.Offset(1, 0).Select
            ActiveCell.PasteSpecial Paste:=xlPasteValues

    Next curCell3

ActiveWorkbook.Sheets("6").Activate
Rows("3:3").Delete
ActiveCell.Offset(2, -199).Select

End Sub

1 个答案:

答案 0 :(得分:0)

Sub Box()

    Dim curCell3 As Range
    Dim rw As Long, f As Range, rngSrch As Range

    Set rngSrch = ActiveWorkbook.Sheets("6").UsedRange.Columns(2)

    For rw = 3 To 720 Step 3

        For Each curCell3 In Sheets("Sheet 2"). _
             Range("b" & rw & ":gs" & rw).Cells

            Set f = rngSrch.Find(curCell3.Value, , xlValues, xlWhole)
            If Not f Is Nothing Then
                curCell3.Offset(0, 1).Value = f.Offset(44, 0).Value
            End If

        Next curCell3

    Next rw

End Sub