Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Двоичный поиск VBA в отсортированном двумерном массиве с набором вспомогательных процедур
 
Цитата
написал:
Возможно кому пригодится...
Дополнил алгоритм для поиска ближайших значений (в отсортированном по колонке поиска одномерном массиве).
Может пригодиться..
Может искать точное вхождение и возвращать -1, если не найдено.
Может искать ближайшее меньшее, или большее, если не найдено точно - см. параметр Eq
Код
' бинарный ускоренный поиск в массиве - возвращает индекс или -1
Public Function BSearchDbl&(arr, ByVal elm As Double, Optional Eq As Integer = 0)
    'Бинарный поиск
    ' Eq = 0 точный поиск, -1 - ближайшее меньшее значение, -2 ближайшее меньшее или первое (без ERROR) 1 - ближайшее большее, 2 - ближайшее большее или последнее (без ERROR)
    Dim max&, min&, tmp&
    min = LBound(arr)
    max = UBound(arr)
    While min <= max
        BSearchDbl = (min + max) \ 2
        If elm < arr(BSearchDbl) Then
            max = BSearchDbl - 1
        ElseIf elm = arr(BSearchDbl) Then
            Exit Function
        ElseIf elm > arr(BSearchDbl) Then
            min = BSearchDbl + 1
        End If
        tmp = tmp + 1
        If min > max And Eq <> 0 Then
            If Eq < 0 Then
                BSearchDbl = max
            Else
                BSearchDbl = min
            End If
            If Eq = -2 And BSearchDbl < LBound(arr) Then
                BSearchDbl = LBound(arr)
            ElseIf Eq = 2 And BSearchDbl > UBound(arr) Then
                BSearchDbl = UBound(arr)
            End If
            Exit Function
        End If
    Wend
    BSearchDbl = -1
End Function

Sub test()
    x = Array(1, 2, 4, 10)
    y = BSearchDbl(x, 3, -2)
    Debug.Print x(y)
End Sub

Так же пример для двухмерного массива
Код
' бинарный ускоренный поиск в массиве - возвращает индекс или -1
Public Function BSearchDbl&(arr, ByVal elm As Double, Optional Col As Integer = 0, Optional WhereCol As Integer = 2, Optional Eq As Integer = 0, Optional ByVal FromRow As Long = -1, Optional ByVal ToRow As Long = -1)
    'Бинарный поиск Col - номер колонки поиска, либо 0, если одномерный массив, WhereCol = 1 или 2 - расположение размерности колонок (часто 2, но кто redim массивы расширяет, у них колонки в 1)
    ' Eq = 0 точный поиск, -1 - ближайшее меньшее значение, -2 ближайшее меньшее или первое (без ERROR) 1 - ближайшее большее, 2 - ближайшее большее или последнее (без ERROR)
    Dim max&, min&, tmp&
    If FromRow = -1 Then FromRow = LBound(arr)
    If ToRow = -1 Then ToRow = UBound(arr)
    min = FromRow
    max = ToRow
    
    While min <= max
        BSearchDbl = (min + max) \ 2
        If Col > 0 And WhereCol = 1 Then
            If elm < arr(Col, BSearchDbl) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(Col, BSearchDbl) Then
                Exit Function
            ElseIf elm > arr(Col, BSearchDbl) Then
                min = BSearchDbl + 1
            End If
        ElseIf Col > 0 And WhereCol = 2 Then
            If elm < arr(BSearchDbl, Col) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(BSearchDbl, Col) Then
                Exit Function
            ElseIf elm > arr(BSearchDbl, Col) Then
                min = BSearchDbl + 1
            End If
        Else
            If elm < arr(BSearchDbl) Then
                max = BSearchDbl - 1
            ElseIf elm = arr(BSearchDbl) Then
                Exit Function
            ElseIf elm > arr(BSearchDbl) Then
                min = BSearchDbl + 1
            End If
        End If
        tmp = tmp + 1
        If min > max And Eq <> 0 Then
            If Eq < 0 Then
                BSearchDbl = max
            Else
                BSearchDbl = min
            End If
            If Eq = -2 And BSearchDbl < FromRow Then
                BSearchDbl = FromRow
            ElseIf Eq = 2 And BSearchDbl > ToRow Then
                BSearchDbl = ToRow
            End If
            Exit Function
        End If
    Wend
    BSearchDbl = -1
End Function

Пример вызова

PairsInHistoryPos = BSearchDbl(arr:=Массив где ищем, elm:=Что ищем, Col:=Колонка поиска, WhereCol:=Расположение колонок в 2D, Eq:=-2, FromRow:=С какой строки ищем, ToRow:=По какую строку ищем)
Страницы: 1
Наверх