在vba Excel中查找多个请求(在查找中查找)

时间:2013-11-15 22:01:01

标签: excel vba excel-vba

我正在尝试执行一种嵌套查找请求,用例是我需要在一个工作表上查找一个组,如果找到从找到的行中的单独列中获取用户ID值,然后搜索另一张表中的ID。然后它应该执行一系列操作,然后在第一张表中找到下一个组的出现。

我的代码是

LookupGroup = Split("GroupName1,GroupName2", ",")
For I = 0 To UBound(LookupGroup)
    With Worksheets("RawData").Range("C:C")
        Set C = .Find(LookupGroup(I), LookIn:=xlValues)
        If Not C Is Nothing Then
            FirstAddress = C.Address
            Do
                LookupId = Sheets("RawData").Cells(C.Row, 7).Value
                IdExist = False
                'Check to ensure ID does not exists on Team Members Tab
                Set IdRange = Sheets("Team Members").Range("A:A").Find(LookupId, LookIn:=xlValues)
                If IdRange Is Nothing Then
                    IdExist = True
                End If
                If Not IdExist Then
                    Highlight = True 'trigger to Set row to bold red font
                    If RecordsFound > 0 Then
                        TotalRecords = TotalRecords + RecordsFound
                    End If
                End If
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> FirstAddress
        End If
    End With
Next I

第一次运行正常,但是在达到Set C = .FindNext(C)时,命令返回'Nothing'而不是下一次出现。

如果我注释掉第二个发现

Set IdRange = Sheets("Team Members").Range("A:A").Find(LookupId, LookIn:=xlValues)

然后第一次搜索工作正常并找到所有实例

我做错了什么?

2 个答案:

答案 0 :(得分:5)

更容易获取Find()逻辑并将其放在单独的函数中......

Sub Tester()
Dim LookupGroup, rngGrp As Range, rngMember As Range, I
Dim g As Range, m As Range

    LookupGroup = Split("GroupName1,GroupName2", ",")

    For I = 0 To UBound(LookupGroup)

        Set rngGrp = FindAll(Worksheets("RawData").Range("C:C"), LookupGroup(I))

        If Not rngGrp Is Nothing Then
            For Each g In rngGrp.Cells

                Set rngMember = FindAll(Sheets("Team Members").Range("A:A"), _
                                        g.EntireRow.Cells(7))

                If Not rngMember Is Nothing Then
                    For Each m In rngMember.Cells
                        'do something with m
                    Next m
                Else
                    'flag not found...
                End If
            Next g
        End If
    Next I

End Sub

'find all matching cells in a given range
Function FindAll(rngLookIn As Range, LookFor) As Range

    Dim rv As Range, c As Range, FirstAddress As String
    With rngLookIn
        Set c = .Find(LookFor, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            FirstAddress = c.Address
            Set rv = c
            Do
                Set c = .FindNext(c)
                If Not c Is Nothing Then Set rv = Application.Union(rv, c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
    Set FindAll = rv
End Function

答案 1 :(得分:0)

我知道这是一个老问题,但它可以用另一个搜索替换 FindNext,但在有限的范围内,而不是整个“C”列。 首先使用LastRow 函数找到“C”的最后一行,并使用带有Worksheets("RawData").Range("C1:C" & LRow) 的Find。 最后,不再使用 FindNext,而是再次使用 FindRange("C" & C.Row + 1 & ":C" & LRow)

Public Function LastRow(ByRef wsSheet_I As Worksheet, ByVal lColumn_I As Long) As Long
    Dim LRow As Range

    Set LRow = wsSheet_I.Columns(lColumn_I).Find( _
        What:="*", _
        LookIn:=xlFormulas, _
        Lookat:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
    
    If Not LRow Is Nothing Then
        LastRow = LRow.Row
    Else
        LastRow = 0
    End If
End Function

Public Sub FindInFind()
LookupGroup = Split("GroupName1,GroupName2", ",")
For i = 0 To UBound(LookupGroup)
'new code
    Dim LRow As Long
    LRow = LastRow(Worksheets("RawData"), 3)
    If LRow = 0 Then GoTo ErrorHandling
        Dim C As Range
        Set C = Worksheets("RawData").Range("C1:C" & LRow).Find(LookupGroup(i), LookIn:=xlValues)
'end new code
    'With Worksheets("RawData").Range("C:C")
        'Set C = .Find(LookupGroup(i), LookIn:=xlValues)
        If Not C Is Nothing Then
            'FirstAddress = C.Address
            Do
                LookupId = Sheets("RawData").Cells(C.Row, 7).Value
                IdExist = False
                'Check to ensure ID does not exists on Team Members Tab
                Set IdRange = Sheets("Team Members").Range("A:A").Find(LookupId, LookIn:=xlValues)
                If IdRange Is Nothing Then
                    IdExist = True
                End If
                If Not IdExist Then
                    Highlight = True 'trigger to Set row to bold red font
                    If RecordsFound > 0 Then
                        TotalRecords = TotalRecords + RecordsFound
                    End If
                End If
                'Set C = .FindNext(C)
'new code
                Set C = Worksheets("RawData").Range("C" & C.Row + 1 & ":C" & LRow) _
                  .Find(LookupGroup(i), LookIn:=xlValues)
'end new code
            Loop While Not C Is Nothing 'And C.Address <> FirstAddress
        End If
    End With
Next i

'new code
Exit Sub
ErrorHandling:
'do something with the error
'end new code
End Sub