Бинарный поиск числа в упорядоченном массиве

@dimmarvel · Регистрация: 04.04.2018

Студворк — интернет-сервис помощи студентам

Написать бинарный поиск искомого числа(введенного пользователем) в отсортированном массиве. Написать это всё в модуле.
Сам прекрасно понимаю на словах как работает бинарный поиск но написать на VBA не могу.

Остап Бонд · 04.04.2018, 17:48

Ну напиши хотя-бы про сортированный массив да нам покажи - вдруг кто сподобится продолжить...

@dimmarvel · 04.04.2018, 18:44 **[ТС]**

Вот, прикрепил фото.
Не суть в массиве, любой массив.
Желательно чтобы ещё объяснения написали строчек кода если можно.

@fever brain · 04.04.2018, 20:47

Двоичный поиск VB6

@Catstail · 04.04.2018, 21:55

Вот. Функция BinSearch возвращает индекс элемента (если он найден) или -1, если элемента нет:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Function BinSearch(A() As Integer, v As Integer) As Integer
     b% = LBound(A)
     e% = UBound(A)
     Do
        c% = (e% + b%) / 2
        If A(c%) = v Then
           BinSearch = c%
           Exit Function
        End If
        If (e% - b%) <= 1 Then
           BinSearch = -1
           Exit Function
        End If
        If A(c%) > v Then
           e% = c%
        Else
           b% = c%
        End If
     Loop
End Function
 
Sub test()
Dim X(1 To 10) As Integer
    For i% = 0 To 9
        X(i% + 1) = Array(2, 3, 6, 8, 11, 33, 40, 42, 54, 87)(i%)
    Next i%
    Debug.Print BinSearch(X, 8)    ' вывод 4
    Debug.Print BinSearch(X, 88)  ' -1
    Debug.Print BinSearch(X, 12)  ' -1
    Debug.Print BinSearch(X, 54)  ' 9
    Debug.Print BinSearch(X, 87)  '10
End Sub

@m-ch · 05.04.2018, 08:50

Сообщение от Catstail

Функция BinSearch

число 2 не находит

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Function BinSearch(a() As Long, v As Long) As Long
    Dim b As Long, e As Long, c As Long
    b = LBound(a)
    e = UBound(a)
    While e >= b
        c = (e + b + 1) \ 2
        If a(c) = v Then
            BinSearch = c
            Exit Function
        ElseIf a(c) > v Then
            e = c - 1
        Else
            b = c + 1
        End If
    Wend
    BinSearch = -1
End Function
 
Sub test()
    Dim x(1 To 10) As Long, i As Long
    For i = 0 To 9
        x(i + 1) = Array(2, 3, 6, 8, 11, 33, 40, 42, 54, 87)(i)
    Next i
    Debug.Print BinSearch(x, 1)     ' вывод -1
    Debug.Print BinSearch(x, 2)     ' 1
    Debug.Print BinSearch(x, 8)     ' 4
    Debug.Print BinSearch(x, 88)    ' -1
    Debug.Print BinSearch(x, 12)    ' -1
    Debug.Print BinSearch(x, 54)    ' 9
    Debug.Print BinSearch(x, 87)    '10
End Sub

@Catstail · 05.04.2018, 09:12

А я бы так поступил (две проверки в начале могут многое сэкономить):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Function BinSearch(A() As Integer, v As Integer) As Integer
     b% = LBound(A)
     e% = UBound(A)
     If A(b%) = v Then
           BinSearch = b%
           Exit Function
     End If
     If A(e%) = v Then
           BinSearch = e%
           Exit Function
     End If
     Do
        c% = (e% + b%) \ 2
        If A(c%) = v Then
           BinSearch = c%
           Exit Function
        End If
        If (e% - b%) <= 1 Then
           BinSearch = -1
           Exit Function
        End If
        If A(c%) > v Then
           e% = c%
        Else
           b% = c%
        End If
     Loop
End Function

@fever brain · 05.04.2018, 12:17

Более универсальная функция для поиска в упорядоченном массиве чисел

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Function BSearchDbl&(arr, ByVal elm As Double)
    'Бинарный поиск
    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
    Wend
    BSearchDbl = -1
End Function

Полностью весь модуль с макросом сортировки и примером использования

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
 
Sub Пример_использования()
    Dim i&, SimpleArray, sIsk$, index&
    
    ReDim SimpleArray(500)
    
    'Создаем массив со случайным набором цифр
    For i = 0 To UBound(SimpleArray):     SimpleArray(i) = Fix(Rnd * 100):      Next
    
    
    qSortVar SimpleArray '---Сортируем массив SimpleArray
    
    
    sIsk = InputBox("Введите число от 0 до 100"): Do While sIsk = "": Exit Sub: Exit Do: Loop
    
    
    index = BSearchDbl(SimpleArray, sIsk)
    
    
    MsgBox "Значение " & IIf(index < 0, "не ", "") & "найденно" & vbLf & "Индекс: " & index & vbLf & "Искомое : " & sIsk
    
    
End Sub
 
 
Sub qSortVar(arr, Optional ByVal min& = -1, Optional ByVal max&)
    'Быстрая сортировка
    Dim i&, j&, v, w
    If min < 0 Then min = LBound(arr): max = UBound(arr):
    i = min: j = max: v = arr((i + j) \ 2)
    Do Until i > j: Do While arr(i) < v: i = i + 1: Loop: Do While arr(j) > v: j = j - 1: Loop
        If (i <= j) Then w = arr(i): arr(i) = arr(j): arr(j) = w: i = i + 1: j = j - 1
    Loop
    If min < j Then qSortVar arr, min, j
    If i < max Then qSortVar arr, i, max
End Sub
 
 
Public Function BSearchDbl&(arr, ByVal elm As Double)
    'Бинарный поиск
    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
    Wend
    BSearchDbl = -1
End Function

@dimmarvel · 07.04.2018, 10:36 **[ТС]**

такой вопрос, для чего нужна переменная tmp

@Catstail · 07.04.2018, 10:53

fever brain, строка 10 может сыграть злую шутку. Числа с плавающей точкой лучше не сравнивать на равенство.

@fever brain · 08.04.2018, 05:11

Сообщение от dimmarvel

для чего нужна переменная tmp

Можешь ее удалить, мне она нужна была в ходе разработки чтоб посчитать число проходов
тоесть если массив = 256 элементов то должно быть 7-8 проходов поиска

Сообщение от Catstail

Числа с плавающей точкой лучше не сравнивать на равенство

ну значит для чисел с пл. точкой нужно делать приближения

Новые блоги и статьи Все статьи Все блоги /
Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определенном условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .	Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .

@dimmarvel 3 / 3 / 1 Регистрация: 04.04.2018 Сообщений: 351

	Бинарный поиск числа в упорядоченном массиве 04.04.2018, 17:07. Показов 6871. Ответов 10 Метки нет (Все метки) Написать бинарный поиск искомого числа(введенного пользователем) в отсортированном массиве. Написать это всё в модуле. Сам прекрасно понимаю на словах как работает бинарный поиск но написать на VBA не могу. 0

Остап Бонд Заблокирован
	04.04.2018, 17:48
	Ну напиши хотя-бы про сортированный массив да нам покажи - вдруг кто сподобится продолжить... 0

@dimmarvel 3 / 3 / 1 Регистрация: 04.04.2018 Сообщений: 351
	04.04.2018, 18:44 [ТС]
	Вот, прикрепил фото. Не суть в массиве, любой массив. Желательно чтобы ещё объяснения написали строчек кода если можно. Миниатюры 0

@fever brain oh my god 1456 / 796 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	04.04.2018, 20:47
	Двоичный поиск VB6 0

@dimmarvel 3 / 3 / 1 Регистрация: 04.04.2018 Сообщений: 351
	07.04.2018, 10:36 [ТС]
	такой вопрос, для чего нужна переменная tmp 0

@Catstail Супер-модератор 38203 / 21135 / 4310 Регистрация: 12.02.2012 Сообщений: 34,741 Записей в блоге: 14
	07.04.2018, 10:53
	fever brain, строка 10 может сыграть злую шутку. Числа с плавающей точкой лучше не сравнивать на равенство. 0

Бинарный поиск числа в упорядоченном массиве

Решение