Функции. Расширенные финкции =впр/гпр.

ФУНКЦИЯ ПОИСКА.

 
Function ВПР_ПОИСК(AB1 As String, AB2 As Range, AB3 As Range)
    Dim x As Long
    Dim y As Long

'AB1-Искомое значение AB1
'AB2-Диапозон поиска AB2(x).Value
'AB3-Диапозон вывода AB3(x).Value 

AB1=LCase(AB1)

 For x = 1 To AB2.Count
 'ПОИСК
    For y = 1 To Len(AB2(x).Value)
     If Mid(LCase(AB2(x).Value), y, Len(AB1)) = AB1 Then ВПР_ПОИСК= AB3(x).Value: Exit For
    Next y
 Next x
End Function   

Пример:  
ДИАПОЗОН :

ПОИСК :

                  ФУНКЦИЯ ПОИСКА С СУММИРОВАНИЕМ ИСКОМЫХ ЗНАЧЕНИЙ.

Function ВПР_ПОИСК_СУММ(AB1 As String, AB2 As Range, AB3 As Range, AB4 As Long)
    Dim x As Long
    Dim y As Long

'AB1-Искомое значение AB1
'AB2-Диапозон поиска AB2(x).Value
'AB3-Диапозо вывода AB3(x).Value
'AB4-Как складывать 0-арифметически 1-логически

AB1=LCase(AB1)

 For x = 1 To AB2.Count
 'ПОИСК
    For y = 1 To Len(AB2(x).Value)
     If Mid(LCase(AB2(x).Value), y, Len(AB1)) = AB1 Then
      If AB4 = 0 Then
      ВПР_ПОИСК_СУММ = ВПР_ПОИСК_СУММ + AB3(x).Value
      Else
      ВПР_ПОИСК_СУММ = ВПР_ПОИСК_СУММ & AB3(x).Value & " +"
      End If
     End If
    Next y
 Next x
End Function

Пример:  
ДИАПОЗОН :

ПОИСК :

           
                  ФУНКЦИЯ ПОИСКА С СМЕЩЕНИЕМ.

Function ВПР_СМЕЩ(AB1 As String, AB2 As Range, AB3 As Range, AB4 As Long)
   Dim x As Long
   Dim y As Long

'AB1-Искомое значение AB1
'AB2-Диапозон поиска AB2(x).Value
'AB3-Диапозон вывода AB3(x).Value
'AB4-Смещение

AB1 = LCase(AB1)

For x = 1 To AB2.Count
 For y = 1 To Len(AB2(x).Value)
  If Mid(LCase(AB2(x).Value), y, Len(AB1)) = AB1 Then ВПР_СМЕЩ = AB3(x - AB4).Value: Exit For
 Next y
Next x
End Function