Как выполнить вложенный поиск на основе значений, зависящих от нескольких вкладок?

У меня есть три рабочих листа: "Аккаунты", "JEExtracts" и "Detail Extracts".

New Example with Data

Я хотел бы выполнить поиск на основе значений из Accounts WS, который является уникальным, и найти все совпадения из JEExtracts, затем на основе всех найденных совпадающих значений взять значения другой ячейки, соответствующей этой строке, и выполнить поиск всех экземпляров из Detail извлекает WS.

Когда я это делаю, первая итерация работает. На второй итерации поисковая строка теряет свое значение. Это заканчивается ошибкой, что объект не определен.

Sub FilterAccount()

    Dim c As Range
    Dim searchRng As Range
    Dim searchRng2 As Range
    Dim LastAcc As Long
    Dim LastRowJE As Long
    Dim LastRowDE As Long
    Dim fAddress
    Dim fAddress2

    LastAcc = Sheets("Accounts").Cells(2, 1).End(xlDown).Row
    LastRowJE = Sheets("JournalExtract").Cells(2, 2).End(xlDown).Row
    LastRowDE = Sheets("DetailExtract").Cells(2, 10).End(xlDown).Row

    LastAcc = LastAcc - 1
    LastRowJE = LastRowJE - 1
    LastRowDE = LastRowDE - 1

    ACRow = 2
    ACCol = 1
    JERow = 2
    JECol = 7
    DERow = 2
    DECol = 10

    Worksheets("Accounts").Activate
    Application.ScreenUpdating = False

    'Loop through cells to do the lookup based on value on a particular column of worksheet Accounts
    For Each c In Sheets("Accounts").Range(Cells(ACRow, ACCol), Cells(LastAcc, ACCol))
        'MsgBox (c.Value)

        If IsEmpty(c) = True Then Exit For       'If there is no value found in the cell then exit from the process
        If IsEmpty(c) = False Then               'If there is value found in the cell then search the same value in JournalExtract

            Worksheets("JournalExtract").Activate

            With Sheets("JournalExtract").Range(Cells(JERow, JECol), Cells(LastRowJE, JECol)) 'Using the cells looking up resource name in pivot tab
                Set searchRng = .Find(What:=c.Value) 'Find it

                If Not searchRng Is Nothing Then 'If we find a value
                    fAddress = searchRng.Address 'Set the address to compare

                    Do
                        searchRng.Offset(0, 0).Cells.Interior.Color = RGB(255, 0, 0)
                        Worksheets("DetailExtract").Activate

                        'Using the value from worksheet JournalExtract looking up value in DetailExtract
                        With Sheets("DetailExtract").Range(Cells(DERow, DECol), Cells(LastRowDE, DECol))

                            Set searchRng2 = .Find(What:=searchRng.Offset(0, 4)) 'Find it
                            If Not searchRng2 Is Nothing Then
                                fAddress2 = searchRng2.Address

                                Do
                                    searchRng2.Offset(0, 0).Cells.Interior.Color = RGB(255, 255, 0)
                                    Set searchRng2 = .FindNext(searchRng2)
                                Loop While Not searchRng2 Is Nothing And searchRng2.Address <> fAddress2

                            End If
                            Set searchRng2 = Nothing

                        End With

                        Worksheets("JournalExtract").Activate
                        Set searchRng = .FindNext(searchRng) 'Doesn't get value in 2nd iteration

                    Loop While Not searchRng Is Nothing And searchRng.Address <> fAddress 'Here error is thrown - Object value not set.

                End If

            End With

        End If
        Set searchRng = Nothing
    Next

    Application.ScreenUpdating = True

End Sub

Пара Find / FindNext может использоваться только по одному. Если вы попытаетесь найти / FindNext, используя значение из первого Find / FindNext, первое будет удалено и заменено вторым. Вам нужен альтернативный метод определения местоположения для вложенного поиска.

user4039065 26.10.2018 04:36

Спасибо за быстрый ответ, я старался изо всех сил, но потерпел неудачу. Я думаю, что сначала значения автофильтрации во 2-м узле на основе значения от 1-го, а затем выполните find / findnext. :(

AnsumanM 26.10.2018 04:56
0
2
89
2

Ответы 2

Пара Find / FindNext может использоваться только по одному. Если вы попробуете вложенный Find / FindNext, используя значение из первого Find / FindNext, первое будет удалено и заменено вторым. Вам нужен альтернативный метод расположения для вложенного поиска, или вы можете изолировать каждый процесс.

Надеюсь, это ближе к тому, что вам нужно, но я не тестировал его полностью. Он строит объединение из результатов первой пары Find / FindNext, а затем циклически проходит через это объединение диапазонов для обработки второй пары Find / FindNext.

Option Explicit

Sub FilterAccount()


    Dim c As Range, s As Range
    Dim searchRng As Range, foundRng As Range
    Dim searchRng2 As Range
    Dim LastAcc As Long, LastRowJE As Long, LastRowDE As Long
    Dim ACRow As Long, ACCol As Long, JERow As Long, JECol As Long, DERow As Long, DECol As Long
    Dim fAddress As String, fAddress2 As String

    LastAcc = Worksheets("Accounts").Cells(Rows.Count, "A").End(xlUp).Row - 1
    LastRowJE = Worksheets("JournalExtract").Cells(Rows.Count, "B").End(xlUp).Row - 1
    LastRowDE = Worksheets("DetailExtract").Cells(Rows.Count, "J").End(xlUp).Row - 1

    ACRow = 2
    ACCol = 1
    JERow = 2
    JECol = 7
    DERow = 2
    DECol = 10

    With Worksheets("Accounts")

        'Loop through cells to do the lookup based on value on a particular column of worksheet Accounts
        For Each c In .Range(.Cells(ACRow, ACCol), .Cells(LastAcc, ACCol))

            'If there is no value found in the cell then exit from the process
            If IsEmpty(c) Then
                Exit For
            Else

                With Worksheets("JournalExtract")

                    'Using the cells looking up resource name in pivot tab
                    With .Range(.Cells(JERow, JECol), .Cells(LastRowJE, JECol))

                        Set searchRng = .Find(What:=c.Value) 'Find it

                        'If we find a value
                        If Not searchRng Is Nothing Then
                            fAddress = searchRng.Address 'Set the address to compare
                            Set foundRng = searchRng
                            'collect all the searchRngs into a union
                            Do
                                Set foundRng = Union(foundRng, searchRng)
                                Set searchRng = .FindNext(after:=searchRng)
                            Loop While searchRng.Address <> fAddress

                            foundRng.Cells.Interior.Color = RGB(255, 0, 0)

                            'now on to the second search
                            'cycle through the union
                            For Each s In foundRng

                                With Worksheets("DetailExtract")
                                    'Using the value from worksheet JournalExtract looking up value in DetailExtract
                                    With .Range(.Cells(DERow, DECol), .Cells(LastRowDE, DECol))

                                        Set searchRng2 = .Find(What:=c.Offset(0, 4)) 'Find it

                                        If Not searchRng2 Is Nothing Then

                                            fAddress2 = searchRng2.Address

                                            Do
                                                searchRng2.Offset(0, 0).Cells.Interior.Color = RGB(255, 255, 0)
                                                Set searchRng2 = .FindNext(searchRng2)
                                            Loop While searchRng2.Address <> fAddress2

                                        End If
                                    End With
                                End With
                            Next s
                        End If
                    End With
                End With
            End If

        Next c
    End With

End Sub

Отличное направление, на шаг ближе. Спасибо за большие знания и время. Основное внимание уделяется поиску значения смещения из второй вкладки в пределах третьей вкладки. Таким образом, поток похож на то, что мне нужно получить учетную запись с 1-й вкладки, получить кратные учетные записи со 2-й вкладки, затем получить все идентификаторы ссылок всех учетных записей, найденных со 2-й вкладки, затем найти все идентификаторы ссылок с 3-й вкладки. Я загрузил другое изображение для примера. В настоящее время он находит в результирующем наборе только идентификатор первой ссылки, но не следующий.

AnsumanM 26.10.2018 17:56

Вы можете использовать SQL для запроса ваших данных. Обратите внимание, что я заменил Accounts на Account. Образец рабочей тетради.

Sub FindValues()

    Dim c%, sql$, conn_string$
    Dim rs As Object
    Dim wksOutput As Worksheet

    conn_string = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                  "Data Source=" & ThisWorkbook.FullName & ";" & _
                  "Extended Properties=""Excel 12.0"";"

    Set rs = CreateObject("ADODB.Recordset")
    rs.CursorLocation = adUseClient

    sql$ = "SELECT A.Account, J.[Link ID], DE.[Values] " & _
           "FROM ([Accounts$] AS A " & _
           "INNER JOIN [JEExtracts$] AS J " & _
                "ON A.Account = J.Account) " & _
            "INNER JOIN ['Detail Extracts$'] AS DE " & _
                "ON J.[Link ID] = DE.[Link ID];"

    rs.Open sql, conn_string, adOpenForwardOnly, adLockReadOnly

    If rs.RecordCount > 0 Then
        Set wksOutput = Sheets.Add(After:=Sheets(Sheets.Count))
        wksOutput.Name = "output"
        With wksOutput
            '// Output headers
            For c = 0 To rs.Fields.Count - 1
                .Cells(1, c + 1) = rs.Fields(c).Name
            Next
            .Range("A2").CopyFromRecordset rs
        End With
    Else
        MsgBox "No records were found.", vbExclamation
    End If

    rs.Close
    Set rs = Nothing

End Sub

Другие вопросы по теме