Find Next仅适用于第一次迭代

时间:2016-12-09 19:21:07

标签: vba excel-vba excel

enter image description here

关于我的查找,我有一个问题,很可能是我错误地编写了代码。因此,如果我有数字810(即f),找到地址,再次810找到810其他位置的地址,依此类推......

然后我让前两个工作正常。因此,当findnext第一次以我想要的方式工作时,粘贴到最后一个单元格,但其他单元格不起作用。所以当我第二次找到下一个时,它不再复制和粘贴了。知道如何解决它吗?

With RgnScenarioScenario

    Set f = .Find(What:=f, LookIn:=xlValues, LookAt:=xlWhole)
    WsScenarios.Activate
    f.Select
    q = f.Address
    Set x = Range("A:A").FindNext(f)
    x.Select
    z = x.Address
    Set m = Range("A:A").FindNext(f)
    m.Select
    n = m.Address
    Set k = Range("A:A").FindNext(f)
    k.Select
    w = k.Address
    Set a = Range("A:A").FindNext(f)
    a.Select
    g = a.Address

    If q <> z Then

    Range(z).Offset(0, 5).Select
    Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 6)).Copy

    WsOutput.Activate
    WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    Else

    End If

    If z <> n Then

    Range(n).Offset(0, 5).Select
    Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 6)).Copy

    WsOutput.Activate
    WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Else

    End If

    If n <> w Then

    Range(n).Offset(0, 5).Select
    Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 5)).Copy

    WsOutput.Activate
    WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Else

    End If

    If w <> g Then

    Range(n).Offset(0, 5).Select
    Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 5)).Copy

    WsOutput.Activate
    WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Else

    End If

    End With
    Next f

我的代码所寻找的是Scenario ID的范围值,在这种情况下是810.正如您在第一个打印屏幕中看到的那样,我有3次810.在下面只是标识2.这是问题所在,它应该是尽可能多地识别它。我在这件事上挣扎。我试过Autofilter,但没有解决我的问题。这完全与行动ID有关。有3个,所以,我的代码应该带3个

1 个答案:

答案 0 :(得分:4)

附件是&#39; FindAll&#39;您可能可以使用的功能吗?

Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: Set SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = CurrRange
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, CurrRange)
            Else: Exit Do
            End If
        Loop
    End If
End Function