在选定范围内循环 VBA答案

【问题标题】：Looping VBA within selected range在选定范围内循环 VBA
【发布时间】：2018-02-21 12:00:04
【问题描述】：

我无法阻止我的 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

提前致谢

艾多斯

【问题讨论】：

标签： vba loops range

【解决方案1】：

这是 FindNext 帮助文本中的引述

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

我认为这适用于你的情况

【讨论】：

【解决方案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

【讨论】：