在 VBA 中循环动态命名范围

Looping through Dynamic Named Range in VBA

我在 Sheet2 "TransTypes" 中的动态命名范围上有一个嵌套循环,我将其定义为:

=OFFSET(Sheet2!$A,0,0,COUNTA(Sheet2!A:A),1)

我的循环如下:

Sub Repeat_trans_type()
    Dim Trans_type_count As Integer, wb As Workbook, wsMain As Worksheet, nwb As Workbook
    Dim i As Integer, nws As Worksheet, wsSheet2 As Worksheet, j As Integer, cell As Range
    Dim k As Integer


    Trans_type_count = Sheet2.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count

    Application.ScreenUpdating = False

    Set wb = Workbooks("Book1.xlsm")
    Set wsMain = wb.Sheets("Sheet1")
    Set wsSheet2 = wb.Sheets("Sheet2")

    j = 1
    k = 1

Set nwb = Workbooks.Add
Set nws = nwb.Sheets(1)

For j = 1 To 96
        i = 1
        Set cell = Nothing
        For Each cell In wsSheet2.Names("TransTypes").RefersToRange.Cells            
        wsMain.Range("A" & j, "C" & j).Copy
        nws.Range("A" & k).PasteSpecial xlPasteValues
        nws.Range("A" & k).PasteSpecial xlPasteFormats
        wsSheet2.Range("A" & i).Copy
        nws.Range("D" & k).PasteSpecial xlPasteValues
        nws.Range("D" & k).PasteSpecial xlPasteFormats
        i = i + 1
        k = k + 1
    Next cell
    Next j
End Sub

嵌套循环的第一次迭代工作正常,但是当它第二次开始执行时,即 j=2,我收到错误消息:

Application-defined or object-defined error

截至目前,我已经使用以下方法解决了这个问题:

For Each cell In wsSheet2.Range("A1", wsSheet2.Range("A1").End(xlDown))

而不是直接使用命名范围。

任何关于为什么偏移方法不起作用的想法都将不胜感激。

谢谢。

很难说这里出了什么问题,但我建议您尝试以下操作:

  • 在for/each
  • 中使用For Each cell In wsSheet2.Range("TransTypes").Cells

For j = 1 To 96
    i = 1
    Set cell = Nothing
    For Each cell In wsSheet2.Range("TransTypes").Cells 'changed this line (2)
        wsMain.Range("A" & j, "C" & j).Copy
        nws.Range("A" & k).PasteSpecial xlPasteValues
        nws.Range("A" & k).PasteSpecial xlPasteFormats
        wsSheet2.Range("A" & i).Copy
        nws.Range("D" & k).PasteSpecial xlPasteValues
        nws.Range("D" & k).PasteSpecial xlPasteFormats
        i = i + 1
        k = k + 1
    Next cell
Next j