Option Explicit
' ============================================================================================================================
' Автор: ZVI:2018-02-15
' Тема на форуме: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=101190&TITLE_SEO=101190-massivy-i-slovari-sortirovka-massivov&MID=837940#message837940
' ============================================================================================================================
' Словарь справочника
' ============================================================================================================================
Public ZVI_Dic As Object
Public Function ZVI_FastVlookUp(ЧтоИскать)
Dim txt$
    If ZVI_Dic Is Nothing Then Application.Run "ZVI_UpdateDic" ' наполнить словарь, если он пустой
txt = ЧтоИскать
'If VarType(ЧтоИскать) = vbString Then txt = Chr$(1) & ЧтоИскать Else txt = ЧтоИскать  'Земенить верхнюю строку на эту, чтобы функция различала число и текст-как-число

    With ZVI_Dic
        If .Exists(txt) Then
            ZVI_FastVlookUp = .Item(txt) 'Если найдено - взять из словаря
        Else
            ZVI_FastVlookUp = ""  ' Если не найдено, то выдать пустое значение или = CVErr(2042), если нужно #Н/Д
        End If
    End With
End Function
' ============================================================================================================================
' Процедура наполнения/обновления словаря. Запуск вручную или кодом
' ============================================================================================================================
' Пример кода автообновления справочника. Для модуля листа справочника
'   Option Explicit

'   Dim IsChanged As Boolean  ' Признак изменения листа

'   Private Sub Worksheet_Change(ByVal Target As Range)
'       IsChanged = True
'   End Sub

'   Private Sub Worksheet_Deactivate()
'       If IsChanged Then ZVI_UpdateDic 'При выходе - обновить справочник (c пересчетом листа базы)
'   IsChanged = False
'   End Sub
' ============================================================================================================================
Sub ZVI_UpdateDic()     'Обновление словаря по данным справочника
Const ColFind = 1   'Столбец справочника, где искать (не нужно при использовании именованных диапазонов)
Const ColGet = 2    'Столбец справочника, откуда брать (не нужно при использовании именованных диапазонов)
Dim a(), b()
Dim i&
Dim txt$
' Проинициализировать словарь. Текстовое сравнение с учётом регистра
Set ZVI_Dic = CreateObject("Scripting.Dictionary"): ZVI_Dic.CompareMode = 1
  
' Скопировать справочные данные столбцов поиска и результата в массивы
' Если указаны константы с номерами полей справочника
    With ZVI_List.Range("справочник")
        a() = .Columns(ColFind).Value
        b() = .Columns(ColGet).Value
    End With
' Если используются именованные диапазоны
'a() = [_ZVI_FastVlookUp_Find].Value
'b() = [_ZVI_FastVlookUp_Get].Value

' Заполнить словарь
    With ZVI_Dic
        For i = 1 To UBound(a)
            txt = a(i, 1)
            If Len(txt) > 0 Then
                'If VarType(a(i, 1)) = vbString Then txt = Chr$(1) & txt    'Раскомментировать, чтобы функция различала число и текст-как-число
                .Item(txt) = b(i, 1)
            End If
        Next i
    End With
'ZVI_base.Calculate 'Раскомментировать, для автопересчёта листа-базы
End Sub