Переменная не присваивается в vlookup - PullRequest
0 голосов
/ 07 февраля 2019

У меня есть таблица, которую я пытаюсь использовать, чтобы выполнить vlookup в столбце 2 таблицы и получить данные из столбца 8 таблицы.Однако переменная не будет назначена.Когда код попадет в указанную переменную, продолжайте, не назначая переменную, а затем вообще пропустите оператор if.Я не получаю сообщение об ошибке, код работает так, как будто его там нет.Может кто-нибудь сказать мне, почему этой переменной не присваиваются данные из vlookup

Option Explicit
Dim RevSID As String
Dim RevSupLev As String
Dim RevActive As String
Dim DueDate As Date



Private Sub Contact_Update()
Set CaseRng = CaseRevPvt.DataBodyRange *Another pivot table in the workbook
Set Contact = Worksheets("Tables").ListObjects("Contact") 

 For Each cell In CaseRng

    RevSID = cell.Offset(0, 1)
    RevSupLev = cell.Offset(0, 2)
    RevActive = cell.Offset(0, 3)

    If RevSID = 0 Then 'An integer variable function doesn't need to run if no data
        On Error Resume Next
        End If  

    elseif RevActive = "No" then
         'Do stuff..works fine
    elseif RevSupLev = "String indicated" then
        if PADate>duedate then 'checks PADue for condition
             'does stuff, this works
        else: Call StandRev 'the intent is to do a Vlookup using RevSID,
                'find the matching data in Column2 of the Contact table and assign the
                information in Column8 to lastrev

Private Sub StandRev()
Dim VlookUp As Range
Dim lastrev As Date


With Worksheets("Tables") 'sets a look up range within the table "Contact"
Set VlookUp = Contact.Parent.Range(Contact.ListColumns("SID").DataBodyRange, Contact.ListColumns("Last Review").DataBodyRange)

lastrev = Application.WorksheetFunction.VlookUp(RevSID, VlookUp, 8,False)  '*** problem here -- RevSID variable is assigned in previous sub
' no data is saved in variable, program ends sub

If lastrev > AttempDate2 Then
    'code that will replace lastrev with data in AttempDate2, AttempDate2 varaiable assigned in another sub
End If

End With

End Sub

1 Ответ

0 голосов
/ 07 февраля 2019

Если RevSID не было объявлено явно, то RevSID в процедуре1 не будет той же переменной, что и RevSID в процедуре2: необъявленные переменные всегда имеют локальную область видимости, поэтому назначение их в процедуре2 не повлияет назначение переменной с тем же именем в процедуре 1.

Но это не то, что здесь происходит.Поскольку RevSID где-то объявлено , ваш поиск должен завершиться сбоем (то есть он не находит значение RevSID в таблице поиска).

Я предложу совершенно иной подход,вместо этого используется функция и шаблон, известный как «пример попытки», где у вас есть функция, которая возвращает Boolean и выводит результат в параметре, который передается по ссылке, который имеет осмысленное значение только тогда, когда функция возвращает True - и так как на первый взгляд кажется, что столбец [SID] не является самым левым в таблице (почему бы вам не пройти до Contact.Parent в противном случае?), Я предлагаю использоватьКомбинация INDEX и MATCH для выполнения поиска - обратите внимание, как порядок столбцов становится неактуальным с этим подходом поиска.

Вот версия с ранними связями WorksheetFunction вызовами, которые вызывают ошибку времени выполнения приошибка:

Private Function TryGetRevisionDate(ByVal SID As String, ByRef outResult As Date) As Boolean
    On Error GoTo CleanFail

    With Application.WorksheetFunction
        Dim matchRow As Long
        matchRow = .Match(SID, Contact.ListColumns("SID").DataBodyRange, 0)

        Dim indexValue As Variant
        indexValue = .Index(Contact.ListColumns("Last Review").DataBodyRange, matchRow)
    End With

    If IsDate(indexValue) Then outResult = indexValue
    TryGetRevisionDate = True

CleanExit:
    Exit Function

CleanFail:
    'lookup failed
    Resume CleanExit
End Function

И версия с поздним связыванием WorksheetFunction вызовов, которые возвращают значение ошибки при ошибке (обратите внимание, что в параметре нетfo, и нет проверки во время компиляции с кодом с поздним связыванием, так что следите за опечатками - Option Explicit не может спасти вас здесь):

Private Function TryGetRevisionDate(ByVal SID As String, ByRef outResult As Date) As Boolean
    With Application

        Dim matchRow As Variant
        matchRow = .Match(SID, Contact.ListColumns("SID").DataBodyRange, 0)
        If IsError(matchRow) Then Exit Function

        Dim indexValue As Variant
        indexValue = .Index(Contact.ListColumns("Last Review").DataBodyRange, matchRow)
        If IsError(indexValue) Then Exit Function

    End With

    If IsDate(indexValue) Then
        outResult = indexValue
        TryGetRevisionDate = True
    End If

End Function

Используя любую версию, ваш код вызова теперь может делатьэто:

Dim revDate As Date
If TryGetRevisionDate(RevSID, revDate) Then
    MsgBox revDate
Else
    MsgBox "SID '" & RevSID & "' was not found."
End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...