Question

我无法阻止我的VBA在我指定的范围内循环，有人可以检查我的代码并告诉我我的错误在哪里。

Option Explicit

Sub Macro()

Dim oWs As Worksheet
Dim rSearchRng As Range
Dim lEndNum As Long
Dim vFindVar As Variant
Dim loc As Range
Dim LastRow As Long
Dim LRow As Long
Dim Copy As Range

Set oWs = ActiveWorkbook.Worksheets("Sheet1")
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

lEndNum = oWs.Range("A2").End(xlDown).Row
Set Copy = oWs.Range("A2" & LRow)
Set rSearchRng = oWs.Range("A2:A" & CStr(lEndNum))

Set loc = rSearchRng.Cells.Find(Range("O2").Value)

If Not loc Is Nothing Then
 Do Until loc Is Nothing
 loc.Select
 Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 12)).Select
 Selection.Copy
 Sheets("Sheet2").Select
 LastRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
 Range("A" & LastRow).Select
 Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
 SkipBlanks:=False, Transpose:=False
 ActiveSheet.Paste
 Sheets("Sheet1").Select
 Application.CutCopyMode = False
 Set loc = rSearchRng.FindNext(loc)
 Loop
End If

Set loc = Nothing


MsgBox "Complete"
End Sub

提前致谢

Aydos

Answer 1

以下是FindNext

上的帮助文本中的引用

当搜索到达指定搜索范围的末尾时，它会回绕到范围的开头。要在发生此环绕时停止搜索，请保存第一个找到的单元格的地址，然后针对此保存的地址测试每个连续的找到单元格地址。

我认为这适用于您的情况

Answer 2

这是因为Find（）方法继续进入范围内因此，当它通过监视其地址回绕到第一个找到的单元格时必须停止它，如下所示（以及其他一些重构）：

Sub Macro()

    Dim oWs As Worksheet
    Dim rSearchRng As Range
    Dim lEndNum As Long
    Dim vFindVar As Variant
    Dim loc As Range
    Dim LastRow As Long
    Dim LRow As Long
    Dim Copy As Range

    Set oWs = ActiveWorkbook.Worksheets("Sheet1")
    LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    lEndNum = oWs.Range("A2").End(xlDown).Row
    Set Copy = oWs.Range("A2" & LRow)
    Set rSearchRng = oWs.Range("A2:A" & CStr(lEndNum))

    Dim locFirstAddress As String

    Set loc = rSearchRng.Cells.Find(Range("O2").value)

    If Not loc Is Nothing Then
        locFirstAddress = loc.Address
        Do
            Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 12)).Copy
            With Sheets("Sheet2")
                .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Paste
            End With
            Application.CutCopyMode = False
            Set loc = rSearchRng.FindNext(loc)
        Loop While loc.Address <> locFirstAddress
    End If

    Set loc = Nothing


    MsgBox "Complete"
End Sub

在所选范围内循环VBA

2 个答案: