Поиск данных в массиве vba excel

В данной статье показаны 2 способа быстрого поиска значений в двумерных массивах.

Поскольку искомое значение может встретиться в нескольких строках обрабатываемого двумерного массива,

оба способа получают на выходе отфильтрованный двумерный массив.

Способы формирования отфильтрованных массивов — разные:

первый способ использует функцию ArrAutofilterEx

второй способ — функцию ArraySearchResults

Основные отличия и особенности этих 2 способов поиска:

• ArrAutofilterEx позволяет задавать несколько критериев поиска (фильтрации)
• ArrAutofilterEx ищет вхождение искомого текста в значения заданных столбцов (неточное совпадение)
• ArrAutofilterEx при каждом вызове заново в цикле перебирает все элементы массива,
  соответственно, при поиске 10 значений время работы кода увеличивается в 10 раз
• ArraySearchResults позволяет использовать фильтрацию массива только по одному столбцу
• ArraySearchResults ищет совпадение искомого текста со значением столбца (точное совпадение)
• ArraySearchResults производит поиск в заранее сформированной текстовой строке
  Таким образом, перебираются все ячейки массива в цикле только один раз, и поиск 100 значений в массиве займёт ненамного больше времени, чем поиск 1 значения.

Примеры поиска в огромных массивах:

Поиск с использованием ArrAutofilterEx

Sub ПримерМедленногоПоискаВМассиве()
    t = Timer
    ИскомоеЗначение$ = 560
    СтолбецДляПоиска& = 3
 
    ' загружаем массив с листа
    arr = [a1:d30000].Value
 
    ' укорачиваем массив Arr, оставляя лишь те строки,
    ' где в заданном столбце есть искомое значение
    On Error Resume Next: Err.Clear
    resArr = ArrAutofilterEx(arr, СтолбецДляПоиска& & "=" & ИскомоеЗначение$)
 
    ' проверяем возвращеное функцией значение на наличие результатов поиска
    If Err Then Debug.Print "Такие строки в массиве не найдены": Exit Sub
 
    ' выводим из отфильтрованных строк значения первого столбца
    For i = LBound(resArr) To UBound(resArr)
        Debug.Print "Результат - строка " & i & " из " & UBound(resArr) & ": ", resArr(i, 1)
    Next i
    Debug.Print "Время: " & Timer - t & " сек."
End Sub

Поиск с использованием ArraySearchResults

Sub ПримерБыстрогоПоискаВМассиве()
    t = Timer
    ИскомоеЗначение$ = 560
    СтолбецДляПоиска& = 3
 
    ' загружаем массив с листа
    arr = [a1:d30000].Value
 
    ' формируем строку поиска
    ss$ = SearchString(arr, СтолбецДляПоиска&)
 
    ' укорачиваем массив Arr, оставляя лишь те строки,
    ' где в заданном столбце есть искомое значение
    resArr = ArraySearchResults(arr, ss$, ИскомоеЗначение$)
 
    ' проверяем возвращеное функцией значение на наличие результатов поиска
    If Not IsArray(resArr) Then Debug.Print "Такие строки в массиве не найдены": Exit Sub
 
    ' выводим из отфильтрованных строк значения первого столбца
    For i = LBound(resArr) To UBound(resArr)
        Debug.Print "Результат - строка " & i & " из " & UBound(resArr) & ": ", resArr(i, 1)
    Next i
    Debug.Print "Время: " & Timer - t & " сек."
End Sub

Код функции ArraySearchResults:

Function ArraySearchResults(ByRef arr, ByRef searchStr As String, ByVal txt As String, _
                            Optional ByVal Sep As String = "%$%") As Variant
    ' функция получает в качестве параметров массив Arr,
    ' и заранее сформированную строку SearchString из значений ячеек нужного столбца массива
    ' По этой строке SearchString функция ищет строки массива, в которые встречается значение txt,
    ' и возвращает усечённый массив, содержащий только подходящие строки
    ' Поиск ведётся по ТОЧНОМУ совпадению значений

    ro& = 0: spl = Split(searchStr, Sep & txt & Sep)
    If UBound(spl) = 0 Then Exit Function    ' нет в массиве нужных строк
    ' перебираем результаты поиска, вычисляя номера строк в исходном массиве
    For i = LBound(spl) To UBound(spl) - 1
        txt = spl(i): ro& = ro& + 1 + (Len(spl(i)) - Len(Replace(spl(i), Sep, ""))) / Len(Sep)  2
        spl(i) = ro&
    Next i
    ' подготавливаем массив для результатов:
    ' по ширине - как исходный, по высоте - содержащий столько строк, сколько найдено совпадений
    ReDim resArr(1 To UBound(spl), LBound(arr, 2) To UBound(arr, 2))
    ' заполняем новый массив
    For i = LBound(spl) To UBound(spl) - 1
        For j = LBound(arr, 2) To UBound(arr, 2)
            resArr(i + 1, j) = arr(spl(i), j)
        Next j
    Next i
    ArraySearchResults = resArr
End Function
 
Function SearchString(ByRef arr, ByVal ArrayColumn As Long, _
                      Optional ByVal Sep As String = "%$%") As String
    ' Объединяет все значения из столбца ArrayColumn массива Arr в одну текстовую строку,
    ' в качестве разделителя элементов используя строку Sep
    ' Для ускорения конкатенации длинных строк используются
    ' промежуточные переменные buffer$ и buffer2$
    buffer$ = "": buffer2$ = "": Sep2$ = Sep$ & Sep$: Const BufferLen& = 6000
    On Error Resume Next: Err.Clear: SearchString = Sep2$
    If ArrayColumn > UBound(arr, 2) Or ArrayColumn < LBound(arr, 2) Then Exit Function
    For i = LBound(arr) To UBound(arr)
        buffer$ = buffer$ & Trim$(arr(i, ArrayColumn)) & Sep2$
        If Len(buffer$) > BufferLen& Then
            buffer2$ = buffer2$ & buffer$: buffer$ = ""
            If Len(buffer2$) > BufferLen& * 20 Then _
               SearchString = SearchString & buffer2$: buffer2$ = ""
        End If
    Next i
    SearchString = SearchString & buffer2$ & buffer$
End Function

При поиске только одного значения время работы обоих макросов поиска не сильно отличается — но обычно функция ArraySearchResults оказывается немного быстрее.

This tutorial will demonstrate how to Search for (Find) a Value in an Array in VBA

There are a number of ways you can search for a string in an array – depending on whether the array is a one dimensional or multi-dimensional.

Searching in a One-Dimensional Array

To search for a value in a one-dimensional array, you can use the Filter Function.

Dim z As Variant
'filter the original array
  z = Filter(Array, String, True, vbCompareBinary)

The Syntax of the Filter option is a follows

Filter(Source Array, Match as String, [Include as Boolean], [Compare as vbCompareMethod])

The Source Array and the Match as String are required while the Include as Boolean and the Compare as vbCompareMethod are optional.  If these are not included they are set to True and vbCompareBinary respectively.

Find values that match the Filter

Sub FindBob()
   'Create Array
   Dim strName() As Variant
   strName() = Array("Bob Smith", "John Davies", "Fred Jones", "Steve Jenkins", "Bob Williams")
   
   'declare a variant to store the filter data in
   Dim strSubNames  As Variant

  'filter the original array
   strSubNames = Filter(strName, "Bob")

   'if you UBound value is greater than -1, then the value has been found
   If UBound(strSubNames ) > -1 Then MsgBox ("I found Bob")
End Sub

The second array will hold the values found by the filter.  If your UBound values are not -1, then the array has managed to find the  value that you were searching for.

You can also see how many times the text appears in the original array.

Sub CountNames()
   'Create array
   Dim strName() As Variant
   strName() = Array("Bob Smith", "John Davies", "Fred Jones", "Steve Jenkins", "Bob Williams")

  'declare an array to store the filter data in
   Dim strSubNames As Variant

   'filter the original array
   strSubNames = Filter(strName, "Bob")

   'if you add 1 to the UBound value, we will get the number of times the text appears
   Msgbox  UBound(strSubNames) + 1 & " names found." 
End Sub

Find values that DO NOT match the Filter

The [Include as Boolean] option allows you to find how many values in your array which DO NOT match your filter

Sub CountExtraNames() 
  'create array
  Dim strName() As Variant 
  strName() = Array("Bob Smith", "John Davies", "Fred Jones", "Steve Jenkins", "Bob Williams") 

  'declare an array to store the filter data in 
  Dim strSubNames As Variant 

  'filter the original array 
  strSubNames = Filter(strName, "Bob", False) 

  'if you add 1 to the UBound value, we will get the number of times the text appears 
  Msgbox  UBound(strSubNames) + 1 & " names found." 
End Sub

we have therefore amended this line:

strSubNames = Filter(strName, "Bob")

with this line:

strSubNames = Filter(strName, "Bob", False)

Using this line in the code, would return all the names that do NOT match “Bob”.

Case Sensitive Filters

You will find that the filter is case sensitive by default.  This is true for all VBA functions.  If you want to search for text that is not case sensitive, you need to amend your code slightly.

z = Filter(strName, "bob",, vbTextCompare)

Adding vbTextCompare to your filter line will enable your code to find “bob” or “Bob”.  If this is omitted, VBA by default uses vbBinaryCompare which will only look for data that is an EXACT match.  Notice in the example above, we have left out the [Include as Boolean] argument so True is assumed.

Option Compare Text

Alternatively, you can add the text Option Compare Text to the top of your module – this will make all the functions that you write in that particular module case insensitive.

Using a Loop to Search through an array

Using a loop is a little bit more complicated than using the Filter function.  We can create a function that will loop through all the values in the array.

Sub LoopThroughArray()
  'create array
  Dim strName() As Variant 
  strName() = Array("Bob Smith", "John Davies", "Fred Jones", "Steve Jenkins", "Bob Williams") 

Dim strFind as string 
strFind = "Bob"

Dim i As Long
'loop through the array
   For i = LBound(strName, 1) To UBound(strName, 1)
       If InStr(strName(i), strFind) > 0 Then
          MsgBox "Bob has been found!"
          Exit For
       End If
    Next i
End Sub

In order to find a part of the text string ie “Bob” instead of “Bob Smith” or “Bob Williams”, we needed to use the Instr Function in the If Statement.  This looked in the string returned by the loop from the Array to see if “Bob” was in the string, and as it was in the string, it would return a message box and then Exit the Loop.

Searching in a Multi-Dimensional Array

We also use the loop to search through a multi-dimensional array.  Once again, we need to create a function than enables us to loop through all the values in the array, but this time, we also need to loop through each dimension of the array.

Function LoopThroughArray()
   Dim varArray() As Variant
   Dim strFind As String
   strFind = "Doctor"
'declare the size of the array
   ReDim varArray(1, 2)
'initialise the array
   varArray(0, 0) = "Mel Smith"
   varArray(0, 1) = "Fred Buckle"
   varArray(0, 2) = "Jane Eyre"
   varArray(1, 0) = "Accountant"
   varArray(1, 1) = "Secretary"
   varArray(1, 2) = "Doctor"
'declare variables for the loop
   Dim i As Long, j As Long
'loop for the first dimension
   For i = LBound(varArray, 1) To UBound(varArray, 1)
'loop for the second dimension
      For j = LBound(varArray, 2) To UBound(varArray, 2)
'if we find the value, then msgbox to say that we have the value and exit the function
         If varArray(i, j) = strFind Then
            MsgBox "Doctor has been found!"
            Exit Function
         End If
      Next j
   Next i
End Function

Completing remark to Jimmy Pena’s accepted answer

As SeanC points out, this must be a 1-D array.

The following example call demonstrates that the IsInArray() function cannot be called only for 1-dim arrays,
but also for «flat» 2-dim arrays:

Sub TestIsInArray()
    Const SearchItem As String = "ghi"
    Debug.Print "SearchItem = '" & SearchItem & "'"
    '----
    'a) Test 1-dim array
    Dim Arr As Variant
    Arr = Split("abc,def,ghi,jkl", ",")
    Debug.Print "a) 1-dim array " & vbNewLine & "   " & Join(Arr, "|") & " ~~> " & IsInArray(SearchItem, Arr)
    '----
    
        '//quick tool to create a 2-dim 1-based array
        Dim v As Variant, vals As Variant                                       
        v = Array(Array("abc", "def", "dummy", "jkl", 5), _
                  Array("mno", "pqr", "stu", "ghi", "vwx"))
        v = Application.Index(v, 0, 0)  ' create 2-dim array (2 rows, 5 cols)
    
    'b) Test "flat" 2-dim arrays
    Debug.Print "b) ""flat"" 2-dim arrays "
    Dim i As Long
    For i = LBound(v) To UBound(v)
        'slice "flat" 2-dim arrays of one row each
        vals = Application.Index(v, i, 0)
        'check for findings
        Debug.Print Format(i, "   0"), Join(vals, "|") & " ~~> " & IsInArray(SearchItem, vals)
    Next i
End Sub

Function IsInArray(stringToBeFound As String, Arr As Variant) As Boolean
'Site: https://stackoverflow.com/questions/10951687/how-to-search-for-string-in-an-array/10952705
'Note: needs a "flat" array, not necessarily a 1-dimensioned array
  IsInArray = (UBound(Filter(Arr, stringToBeFound)) > -1)
End Function

Results in VB Editor’s immediate window

SearchItem = 'ghi'
a) 1-dim array 
   abc|def|ghi|jkl ~~> True
b) "flat" 2-dim arrays 
   1          abc|def|dummy|jkl|5         False
   2          mno|pqr|stu|ghi|vwx         True