Vlookup против отфильтрованных данных с VBA для Excel - PullRequest
0 голосов
/ 13 декабря 2018
Sub FilteredTest()

    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim myI As Long
    Dim myLookupvalue As Long
    Dim myTableArray As Range

    LastRow1 = Worksheets(2).Cells(Cells.Rows.Count, "A").End(xlUp).Row
    LastRow2 = Worksheets(8).Cells(Cells.Rows.Count, "A").End(xlUp).Row

    Set myTableArray = Worksheets(2).Range("A2:A" & LastRow1)

    myI = 3

    Do Until myI > LastRow2

        myLookupvalue = Worksheets(8).Range("E" & myI)
        On Error Resume Next
        Worksheets(8).Range("H" & myI).Value = WorksheetFunction.VLookup(myLookupvalue, myTableArray, 1, False)
        ' Error 1004 is when the VLOOKUP can't find a corresponding value
        If Err = 1004 Then
            Worksheets(8).Range("H" & myI).Value = "Remove"
        End If
        myI = myI + 1

    Loop
End Sub

Мне нужна помощь, чтобы получить этот код только для Vlookup по сравнению с видимыми значениями на другом листе.

По сути, я хочу, чтобы в главном столбце был H # лист поиска значений в столбце A в другом листе данных и регулярный вывод Iferror с Vlookup в столбце E # на главном листе.

Я пробовалнесколько размещений SpecialCells (xlCellTypeVisible) -функции как вне цикла, так и внутри цикла, но ничего, что я делаю, похоже не работает.Все, что я получаю, это ошибки в коде или ошибки в Vlookup.Я пытался искать на этом сайте и гуглить, как сумасшедший.В этот момент набросил полотенце и решил самостоятельно завести тему.Надеюсь, что кто-то может помочь мне интегрировать функцию в мой код и / или помочь мне лучше понять эту функцию.

1 Ответ

0 голосов
/ 13 декабря 2018

Вы можете добавить эту пользовательскую функцию и поменять WorksheetFunction.VLookup для этой новой «вспомогательной» функции.

Option Explicit

Function VisLookup(lu As Variant, rng As Range, col As Long, _
                   Optional bin As Boolean = False) As Variant

    Dim i As Long

    Set rng = Intersect(rng, rng.Parent.UsedRange)
    VisLookup = CVErr(xlErrNA)
    If col > rng.Columns.Count Then Exit Function

    If bin Then

        For i = 1 To rng.Rows.Count
            If rng.Cells(i + 1, "A").Value2 > lu And Not rng.Rows(i).Hidden Then
                VisLookup = rng.Cells(i, col).Value
                Exit For
            End If
        Next i

    Else

        For i = 1 To rng.Rows.Count
            If lu = rng.Cells(i, "A").Value2 And Not rng.Rows(i).Hidden Then
                VisLookup = rng.Cells(i, col).Value
                Exit For
            End If
        Next i

    End If

End Function

Реализовано как,

Worksheets(8).Range("H" & myI).Value = VisLookup(myLookupvalue, myTableArray, 1, False)
...