Бывает нужно найти необходимое значение не в длинном списке возможных, а в большом списке диапазонов, в один из которых искомое значение входит. В таком случае не помогает промтой перебор всех вариантов, необходимо применять условия сравнения, что значительно замедляет быстродействие.  
Наиболее оптимальным решением здесь является метод бинарного поиска в отсортированном массиве, любезно предложенный Microsoft MVP (Excel) Владимиром Захаровым (ZVI).  
Ниже следует описание решения одной из задач - поиска страны по ее IP-адресу.  
 
Диапазоны здесь представляют собой набор начальных и конечных ip-адресов каждой подсети. Каждая подсеть принадлежит определенной стране. Смысл - узнать страну по ip-адресу, если он находится в пределах какого-то диапазона. Для этого вычисляются контрольные числа по определенной формуле, которые легче сравнивать.  
ipnum = 16777216*w + 65536*x + 256*y + z  
где IP Address = w.x.y.z  
Сложность задачи в том, что приходится сравнивать число с двумя контрольными числами сразу (начало и конец диапазона). Кроме того, в таблице отсутствуют некоторые диапазоны, так как они никому пока не принадлежат (или в таблицу еще не введены).  
Полный список диапазонов в формате csv можно взять с maxmind.com. Следует учесть, что их количество - более 120 тысяч, а это значит, что для расположения на одном листе необходимо использовать Excel 2007 или 2010.  
Поиск в полной базе диапазонов 50 тысяч различных ip-адресов составляет прмерно 1 с. Что является отличным результатом.  
 
Код:  
 
Option Explicit  
 
' ZVI:2010-07-24 Find the countries by sorted numeric IPs  
Sub Ip2Country()  
   
 Dim Rng As Range, a, b, c, d$(), i&, r&, Ub&, v#, x  
   
 ' Screen&Events off  
 With Application  
   .ScreenUpdating = False  
   .EnableEvents = False  
 End With  
   
 ' Copy Beginning & Ending IP Number into a(), Country - into b()  
 With Sheets("Data")  
   If .FilterMode Then .ShowAllData  
   Set Rng = .Range(.Cells(Rows.Count, "C").End(xlUp), "D2")  
   ' Sort by Beginning IP Number  
   Rng.CurrentRegion.Sort .Cells(1, "C"), 1, Header:=xlYes  
   a = Rng.Value  
   Ub = UBound(a)  
   b = Rng.Columns(4).Value  
 End With  
   
 ' Copy IP into c(), create resulting d()  
 With Sheets("History")  
   If .FilterMode Then .ShowAllData  
   Set Rng = .Range("F2", .Cells(Rows.Count, "F").End(xlUp))  
   c = Rng.Value  
   ReDim d(1 To UBound©, 1 To 1)  
 End With  
   
 ' Main  
 For Each x In c  
   r = r + 1  
   v = Ip2Num(x)  
   i = BinSearch(v, a, 1, Ub, 1)  
   If v >= a(i, 1) And v <= a(i, 2) Then d(r, 1) = b(i, 1)  
 Next  
   
 ' Copy the result from d()  
 Rng.EntireRow.Columns("J").Value = d()  
   
 ' Screen&Events on  
 With Application  
   .EnableEvents = True  
   .ScreenUpdating = True  
 End With  
   
End Sub  
 
' ZVI:2010-07-24 Fast binary Search of x in sorted array a()  
Function BinSearch(x, a, Lb1&, Ub1&, Ub2&) As Long  
 Dim i&, Lb&, Ub&, b&  
 Lb = Lb1: Ub = Ub1  
 Do  
   i = (Lb + Ub) \ 2  
   If a(i, Ub2) = x Then  
     BinSearch = i  
     Exit Function  
   ElseIf a(i, Ub2) > x Then  
     b = 0: Ub = i - 1  
   Else  
     b = 1: Lb = i + 1  
   End If  
 Loop Until Lb > Ub  
 BinSearch = i + b - 1  
End Function  
 
' ZVI:2010-07-24 Fast converting of string IP to the numeric one  
Function Ip2Num(Ip) As Double  
 Dim s$, i&, ii&, iii&  
 s = Ip  
 i = InStr(1, s, ".")  
 Ip2Num = 16777216 * CDbl(Mid$(s, 1, i - 1))  
 ii = InStr(i + 1, s, ".")  
 Ip2Num = Ip2Num + 65536 * CDbl(Mid$(s, i + 1, ii - i - 1))  
 iii = InStr(ii + 1, s, ".")  
 Ip2Num = Ip2Num + 256 * CDbl(Mid$(s, ii + 1, iii - ii - 1)) + CDbl(Mid$(s, iii + 1))  
End Function

Добрый день.  
Есть макрос, выполняющий нехитрую работу поиска названия страны ip-адреса по базе ip-адресов (Maxmind). Как известно, существует множество (более 120 тысяч) групп ip-адресов, с каждой из которых ассоциирована отдельная страна. Чтобы было проще искать в базе было придумано контрольное число, вычисляющиеся по формуле:  
         ipnum = 16777216*w + 65536*x + 256*y + z      
                 где IP Address = w.x.y.z  
 
Макрос при поиске 3000 ip-адресов в общей базе справляется за 50 секунд. Ищется альтернативный, более быстрый способ.  
Знаю про использование словаря, но в данном случае не хватает знаний, чтобы применить его.  
Пример в аттаче содержит урезанную версию базы ip-адресов.  
Временные отметки:  
Substring 0,086    
Compare columns 48,25    
Write  0,172    
Total 48,508

Добрый день.  
Есть макрос, который ищет номер телефона по базе префиксов и выдает название страны. Так как префиксы бывают разной длины, то сначала он начинает с 9 цифр, постепенно, уменьшая номер до одной цифры, при условии, что он не найдет совпадение раньше.  
Со своей ролью справляется хорошо, вот только есть чувство, что сделать это можно еще быстрее (с большим списком затрачивает по полчаса). Прошу совета, в каком направлении идти.    
 
Sub Compare()  
Application.ScreenUpdating = False  
Dim CallNumber, trim As Integer  
Dim PrefixNumber As Long  
Dim a As String  
Dim Name As String  
Sheets("Prefix").Select  
For CallNumber = 2 To Worksheets("history").Cells(Rows.Count, 3).End(xlUp).Row  
a = Worksheets("history").Range("C" & CallNumber).Value  
For trim = 0 To 8  
a = Left(a, 9 - trim)  
PrefixNumber = pFindRowPos(a)  
If PrefixNumber <> 0 Then  
Name = Worksheets("Prefix").Range("C" & PrefixNumber).Value  
Worksheets("history").Range("D" & CallNumber).Value = Name  
GoTo 1  
End If  
Next trim  
1:  
Next CallNumber  
Sheets("history").Select  
End Sub  
 
Private Function pFindRowPos(sText As Variant, _  
  Optional SearchDirection As XlSearchDirection = xlNext, _  
  Optional SearchOrder As XlSearchOrder = xlByRows) As Long  
     Dim lResult As Long, oRg As Range  
    Set oRg = Cells.Find(What:=sText, LookIn:=xlValues, _  
    LookAt:=xlWhole, SearchOrder:=SearchOrder, _  
                  SearchDirection:=SearchDirection, _  
    MatchCase:=False, SearchFormat:=False)  
     If Not oRg Is Nothing Then lResult = oRg.Row  
     pFindRowPos = lResult  
     Set oRg = Nothing  
 End Function