Ошибка выполнения 438 при использовании функций Vlookup и IsNA в VBA - PullRequest
1 голос
/ 13 мая 2019

Я создаю код, который сравнивает новые и старые списки, чтобы найти элементы, которые существуют в столбце B, но не в столбце E, и наоборот.Я делаю это для нескольких списков.

В Excel я использую функцию в столбце A и перетаскиваю вниз

=IF(ISNA(VLOOKUP(B4,$E$4:$E$65537,1,FALSE)),"0","1")

Где B содержит идентификатор для старого списка, C содержит имя дляидентификатор для старого списка, а E содержит идентификатор для нового списка.

Example of data

Option Explicit
Option Base 0

' **** Declaring variables ****
' Worksheets and workbooks
Public ws_C                 As Worksheet
Public wkb                  As Workbook

' Integers
Public lr_pos_old           As Integer
Public lr_pos_new           As Integer
Public lr_neg_old           As Integer
Public lr_neg_new           As Integer
Public oldColumn            As Integer
Public newColumn            As Integer
Public StartRow             As Integer
Public i                    As Integer
Public j                    As Integer
Public colSpace             As Integer

' Arrays
Public ListArrOld           As Variant
Public ListArrNew           As Variant



Sub main()
' This sub sets up general declarations and options

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wkb = ThisWorkbook
Set ws_C = wkb.Sheets("Comparison")

StartRow = 4
colSpace = 6
oldColumn = 2
newColumn = 5
lr_pos_old = ws_C.Range("C12").End(xlDown).Row ' Lastrow for old positive list
lr_pos_new = ws_C.Range("F12").End(xlDown).Row ' Lastrow for new positive list
lr_neg_old = ws_C.Range("I12").End(xlDown).Row ' Lastrow for old negative list
lr_neg_new = ws_C.Range("L12").End(xlDown).Row ' Lastrow for new negative list
ListArrOld = Array(lr_pos_old, lr_neg_old)
ListArrNew = Array(lr_pos_new, lr_neg_new)

' Calling subs
Call CompareLists


Application.StatusBar = False
ws_C.Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub CompareLists()
' This sub compares the positive and negative lists from the old and new boardmeeting report

Application.StatusBar = "Comparing new and old lists ..."

' Comparing old vs new list: Value 1 if included in the new list
With Application.WorksheetFunction
    For j = LBound(ListArrOld) To UBound(ListArrOld)
        For i = StartRow To ListArrOld(j)
            ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")
        Next i ' Next row
    Next j ' Next list
End With


' Comparing new vs old: Value 1 if included in the old list
' Similar code

End Sub

Я ожидаю, что столбец A получит значения 0 и1, но вместо этого мой код завершается с ошибкой

ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

с ошибкой

во время выполнения 438 "объект не поддерживает это свойство или метод".

Ответы [ 2 ]

0 голосов
/ 13 мая 2019

Помимо решения, предоставленного Дамианом, я решил свою проблему, изменив строку

ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

на следующее:

 ws_C.Cells(i, 1 + j * colSpace) = _
            IIf(Application.IsNA(Application.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(startrow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

и удаление предложения with в начале. Как уже упоминалось в этой теме, используя Application без worksheetfunction, я избегаю появления ошибки и прерывания моего кода.

0 голосов
/ 13 мая 2019

Это должно сделать трюк и сделать это быстро:

Option Explicit
Sub CompareList()

    Dim LastRow As Long, Col As Byte, i As Long, arrOld, arrNew
    Dim DictOld As New Scripting.Dictionary
    Dim DictNew As New Scripting.Dictionary


    With ThisWorkbook.Sheets("SheetName") ' change this to your sheet name

        'Store the old list into the array and the items into the dictionary
        Col = .Cells.Find("Old List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        arrOld = .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value 'Store the data into the array
        For i = LBound(arrOld) To UBound(arrOld)
            DictOld.Add arrOld(i, 1), i
        Next i

        'Store the new list into the array and the items into the dictionary
        Col = .Cells.Find("New List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        arrNew = .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value 'Store the data into the array
        For i = LBound(arrNew) To UBound(arrNew)
            DictNew.Add arrNew(i, 1), i
        Next i

        'Compare the lists
        For i = LBound(arrOld) To UBound(arrOld)
            If Not DictNew.Exists(arrOld(i, 1)) Then
                arrOld(i, 2) = "Exists in old but not in new"
            Else
                arrOld(i, 2) = "Exists in both"
            End If
        Next i
        Col = .Cells.Find("Old List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value = arrOld


        For i = LBound(arrNew) To UBound(arrOld)
            If Not DictOld.Exists(arrNew(i, 1)) Then
                arrNew(i, 2) = "Exists in new but not in new"
            Else
                arrNew(i, 2) = "Exists in both"
            End If
        Next i
        Col = .Cells.Find("New List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value = arrNew

End Sub
...