Упростить код для поиска в ListBox

@glsn · Регистрация: 12.04.2015

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

Доброго времени суток, уважаемые форумчане
Написал код для поля поиска в ListBox. Возможен ли вариант его упростить? Для понимания строки закомментировал:
============

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
Private Sub plFind_Change()
On Error Resume Next
Dim x As String ' Переменная для поиска
x = Me.plFind.Text ' Значение переменной = тексту в поле поиска
If Len(x) > 0 Then ' Если кол-во символов в поле поиска больше 0, то...
    If Me.cboSvp.Value = 0 Then ' Если выпадающий список совпадений значений cboSvp установлено в положение совпадения по первым набранным символам (значение 0)
    Select Case cboSearch ' множество вариантов задания условия для отбора в запросе при разных положениях выпадающего списка поиска в полях cboSearch
        Case 0: x = " WHERE Left(FIO," & Len(x) & ") = '" & x & "'" ' поиск по полю FIO
        Case 1: x = " WHERE Left(Телефон," & Len(x) & ") = '" & x & "'" ' поиск по полю Телефон
        Case 2: x = " WHERE Left(Адрес," & Len(x) & ") = '" & x & "'" ' поиск по полю Адрес
    End Select
    Else ' в противном случае: если выпадающий список совпадений значений cboSvp установлен в положение 1 - с любой частью слова
    Select Case cboSearch ' множество вариантов задания условия для отбора в запросе при разных положениях выпадающего списка поиска в полях cboSearch
        Case 0: x = " WHERE FIO like '*" & x & "*'" ' поиск по полю FIO
        Case 1: x = " WHERE Телефон like '*" & x & "*'" ' поиск по полю Телефон
        Case 2: x = " WHERE Адрес like '*" & x & "*'" ' поиск по полю Адрес
    End Select
    End If
Else
    x = " "
End If
Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & x ' вставляем условие в запрос
Me.IstList.Requery ' Обновляем список
Me!IstList.Selected(1) = True ' Выделяем первую запись в списке (это просто так)
End Sub

=========
Возможно ли как то создать переменную для полей FIO, Телефон и Адрес, через Select Case задать для нее значения в зависимости от выбора в cboSearch и просто как то вставить переменную в текст WHERE? Надеюсь истолковал понятно...

@glsn · 23.02.2018, 23:32 **[ТС]**

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

А что скажете о быстродействии Choose ?

скажите, а как в Вашей конструкции можно задать условия на cboSearch + ? и cboSvp + ? - чтобы было динамически в зависимости от выбора в этих комбобоксах параметра?
допустим я вставил следующий код

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub plFind_Change()
On Error Resume Next
Dim S, S1 As String
S = " WHERE " & Choose(cboSearch + 1, "FIO", "Телефон", "Адрес") & _
" Like """ & IIf(cboSvp = 0, "", "*") & plFind.Text & "*"""
S1 = " WHERE " & Choose(cboSearch + 1, "FIO", "Телефон", "Адрес") & _
" Like """ & IIf(cboSvp + 1, "", "*") & plFind.Text & "*"""
If Len(S) > 0 Then
    If Me.cboSvp.Value = 0 Then
        Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & S
    Else
        Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & S1
    End If
Else
    S = " "
End If
Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & S
Me.IstList.Requery
Me!IstList.Selected(1) = True
End Sub

===========
работает конечно
Но у меня же еще есть выборка в cboSearch

@Capi · 23.02.2018, 23:49

Все выборки учтены в уже показанной мною единственной строке.
Вы, кстати, внесли ошибку в предложенное выражение.

Сейчас не буду вдаваться в подробности - пишу с планшета.
Потом.

И не забывайте о спасибо.

@glsn · 24.02.2018, 00:13 **[ТС]**

да, но возможен ли полный код? не совсем я все понял просто

Добавлено через 7 минут
если говорить о единственном варианте - то, Ваш код работает, но только при выборе поля поиска cboSearch на позицию 1 - для поля FIO, а критерия поиска совпадения cboSvp в позиции - 0. Но в проекте то предполагается, что мы будем их менять перебирая варианты поиска и полей для поиска. Следовательно получается нужно прописывать строки для каждого случая перебора? не совсем понимаю..

@Eugene-LS · 24.02.2018, 00:59

Capi, потестил .... могу удовлетворить ваше священное любопытство, итак:
Тест-1 (100*000*000 повт.) работал: 00:02:32 - Choose()
Тест-2 (100*000*000 повт.) работал: 00:00:06 - Select Case

Select Case = прибл в 9 раз быстрее Choose() !

Код тестирования:

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

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
58
Private Sub esSpeedCompare2()
'es 19.05.2003 - 25.03.2017 (LE)
'Процедура сравнения работы процедур или функций по скорости
'Пишет результат в Immediate окно
'--------------------------------------------------------------------
Dim intTest As Integer        'счетчик тестов
Dim lngReiterations As Long   'количество повторений теста
Dim l As Long                 'счетчик повторений
Dim t As Date                 'перменная таймера
Dim v As Variant              'для приема значений возвращаемых тестируемыми
Dim sTest$                    'На тестах может пригодиться
Dim iC%
On Error GoTo esSpeedCompare_Err
 
'Установка количества повторений теста (Тут ОСТОРОЖНО - Не вводите сразу много) :
    'lngReiterations = CLng(1000) * 10      ' = Мало - для медленных операций ...
    lngReiterations = CLng(1000) * 100000 ' = Много !!! - Только для быстрых операций
 
'Отделяем линией от (возможных) предидущих результатов
    Debug.Print vbCrLf & "---------------------------------------------------------"
'Запуск 2-х тестов
    For intTest = 1 To 2
        t = Now
        iC = 0
        For l = 1 To lngReiterations
            Select Case intTest
                
                Case 1 'ниже пишем певую тестируемую процедуру|функцию
                    iC = iC + 1
                    v = Choose(l, "FIO", "Телефон", "Адрес")
                    If iC > 3 Then iC = 0
                    
                Case 2 'ниже пишем вторую тестируемую процедуру|функцию
            
                    iC = iC + 1
                    Select Case iC
                        Case 1: v = "FIO"
                        Case 1: v = "Телефон"
                        Case 1: v = "Адрес"
                    End Select
                    If iC > 3 Then iC = 0
 
            End Select
        Next l
        
        'отчет.....
        Debug.Print "Тест-" & intTest & " (" & Format$(lngReiterations, "#,###") & _
            " повт.) работал: " & Format(Now - t, "hh:mm:ss")
    Next intTest
 
esSpeedCompare_Bye:
    Exit Sub
 
esSpeedCompare_Err:
    Debug.Print "Процедура сравнения работы функций по скорости привела к ошибке:" & vbCrLf & _
    Err.Description
    Resume esSpeedCompare_Bye
End Sub

Добавлено через 12 минут
Capi, Насчёт "в 9 раз быстрее" - это я поспешил - в среднем в 5- 6 раз всего.
И тест не "чистый" т.к. мой "калькулятор" выполняет параллельные задачи ...
Но результаты пока таковы.

@Capi · 24.02.2018, 01:04

Eugene-LS,

Спасибо.
Но что-то мне Choose(l, не нравится в 30-й строке.

Завтра попробую по-своему сделать.
Сообщу.

@Eugene-LS · 24.02.2018, 01:09

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

Но что-то мне Choose(l, не нравится в 30-й строке.

Ну там и Case с замятием, правильно так:

Visual Basic
1
2
3
4
5
                    Select Case iC
                        Case 1: v = "FIO"
                        Case 2: v = "Телефон"
                        Case 3: v = "Адрес"
                    End Select

При исправление коэф. снизился немного:

Ну поглючиваю я слегка .... сегодня можно.

@Capi · 24.02.2018, 01:14

Да нет, это я видела, но не стала акцентировать внимание.
Я про другое:

Visual Basic
1
v = Choose(l, "FIO", "Телефон", "Адрес")

тут почему-то анализируется переменная-счетчик повторений, а не iC.

@Eugene-LS · 24.02.2018, 01:21

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

тут почему-то анализируется переменная-счетчик повторений, а не iC.

Ну глючу ...

Исправил ...
Остановил все "паралельки"
Прогнал тест ...

Тест-1 (100*000*000 повт.) работал: 00:01:00
Тест-2 (100*000*000 повт.) работал: 00:00:08

Догадайтесь где - кто? ...

(Мало Изменяемый Аргумент на скорость работы функции влияет слабо)

@Capi · 24.02.2018, 01:31

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

да, но возможен ли полный код? не совсем я все понял просто

Хорошо. Покажу полный код.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub plFind_Change()
 Dim S As String
 If Len(plFind.Text) > 0 Then 
  S = " WHERE " & Choose(cboSearch + 1, "FIO", "Телефон", "Адрес") & _
      " Like """ & Choose(cboSvp + 1, "", "*") & plFind.Text & "*"""
 Else
  S = ""
 End If
 Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & S
 Me.IstList.Selected(1) = True
End Sub

Добавлено через 1 минуту

Сообщение от Eugene-LS

Догадайтесь где - кто?

Ну...
Хорошо.

Но завтра проверю.)))

@Eugene-LS · 24.02.2018, 01:33

Capi, последний вариант:

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

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
58
59
60
Private Sub esSpeedCompare2()
'es 19.05.2003 - 25.03.2017 (LE)
'Процедура сравнения работы процедур или функций по скорости
'Пишет результат в Immediate окно
'--------------------------------------------------------------------
Dim intTest As Integer        'счетчик тестов
Dim lngReiterations As Long   'количество повторений теста
Dim l As Long                 'счетчик повторений
Dim t As Date                 'перменная таймера
Dim v As Variant              'для приема значений возвращаемых тестируемыми
Dim sTest$                    'На тестах может пригодиться
Dim iC%
On Error GoTo esSpeedCompare_Err
 
'Установка количества повторений теста (Тут ОСТОРОЖНО - Не вводите сразу много) :
    'lngReiterations = CLng(1000) * 10      ' = Мало - для медленных операций ...
    lngReiterations = CLng(1000) * 100000 ' = Много !!! - Только для быстрых операций
 
'Отделяем линией от (возможных) предидущих результатов
    Debug.Print vbCrLf & "---------------------------------------------------------"
'Запуск 2-х тестов
    For intTest = 1 To 2
        t = Now
        iC = 0
        For l = 1 To lngReiterations
            Select Case intTest
                
                Case 1 'ниже пишем певую тестируемую процедуру|функцию
                    
                    iC = iC + 1
                    v = Choose(iC, "FIO", "Телефон", "Адрес")
                    If iC > 2 Then iC = 0
                    
                Case 2 'ниже пишем вторую тестируемую процедуру|функцию
            
                    iC = iC + 1
                    Select Case iC
                        Case 1: v = "FIO"
                        Case 2: v = "Телефон"
                        Case 3: v = "Адрес"
                    End Select
                    If iC > 2 Then iC = 0
            
            
            End Select
        Next l
        
        'отчет.....
        Debug.Print "Тест-" & intTest & " (" & Format$(lngReiterations, "#,###") & _
            " повт.) работал: " & Format(Now - t, "hh:mm:ss")
    Next intTest
 
esSpeedCompare_Bye:
    Exit Sub
 
esSpeedCompare_Err:
    Debug.Print "Процедура сравнения работы функций по скорости привела к ошибке:" & vbCrLf & _
    Err.Description
    Resume esSpeedCompare_Bye
End Sub

Показал:
Тест-1 (100*000*000 повт.) работал: 00:01:01
Тест-2 (100*000*000 повт.) работал: 00:00:09

@Capi · 24.02.2018, 01:38

Почти в семь раз?
Интересно...

Спокойной ночи.
До завтра.

@glsn · 24.02.2018, 10:30 **[ТС]**

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

Покажу полный код

...
Мне кажется этого достаточно - спасибо Вам Capi, все работает, все упрощено
С прошедшим всех 23 февраля и Вас лично с наступающим 08.03.18 )
впрочем если есть, что улучшить был бы рад почитать

@Capi · 24.02.2018, 11:04

glsn,

Спасибо за пред-поздравление!!!)))

Что касается улучшений.
На мой взгляд, cboSvp и cboSearch лучше иметь значения (1, 2), а не (0, 1).
Тогда не нужно будет прибавлять им единицу в Choose.

@glsn · 24.02.2018, 11:45 **[ТС]**

я так и сделал с комбобоксами. все в порядке
Код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub plFind_Change()
Dim S As String
If Len(plFind.Text) > 0 Then
    S = " WHERE " & Choose(cboSearch, "FIO", "Телефон", "Адрес") & _
    " Like """ & Choose(cboSvp, "", "*") & plFind.Text & "*"""
 Else
    S = ""
 End If
 Me.IstList.RowSource = "SELECT Код, FIO AS ФИО, Телефон, Адрес FROM Запрос" & S
 Me.IstList.Selected(1) = True
End Sub

повесил еще 1 код на запрет ввода ненужных символов с клавы при выборке полей для поиска с комбобокс cboSearch. Может если еще глядите топик и есть время посмотрите как его можно упростить - опять че-то намудрил наверное. Так то он работает конечно...Идея была такая, что при выборе ФИО - ввод только текста с установкой русского языка для клавиатуры, если ввод "по телефону" - ввод только цифр, а если ввод "адреса" - и того и другого, но только в русской раскладке клавиатуры. Коды искал на форуме в т.ч. вставляя его - поэтому получился винегрет вероятно....
Код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub plFind_KeyPress(KeyAscii As Integer)
    If Me.cboSearch.Value = 1 Then
        If Not (KeyAscii >= 192 Or KeyAscii = 32 Or KeyAscii = 8 Or KeyAscii = 39 Or KeyAscii = 96) Then
            KeyAscii = 0
        Else
        End If
        ElseIf Me.cboSearch.Value = 2 Then
             Select Case KeyAscii
             Case vbKey0 To vbKey9, vbKeyNumpad1 To vbNumpad9, vbKeyDelete, vbKeyBack
             Case Else
             KeyAscii = Empty
             End Select
    Else
        If ((KeyAscii > 64) And (KeyAscii < 91)) Or ((KeyAscii > 96) And (KeyAscii < 123)) Then
            KeyAscii = 0
        End If
    End If
End Sub

Добавлено через 3 минуты
да и в списках разрешенных не запрещал действие клавиш на удаление и Back (т.к. это нужно бывает очистить символ или через Del тест при его наборе в plFind)

@Capi · 24.02.2018, 16:15

Eugene-LS,

Скорости Select Case и Choose сравнила.
По-своему.
Но результат аналогичный.

Более того, при увеличении числа вариантов выбора разница в скорости существенно растет.
Конечно, в пользу Select Case.
И даже при единственном варианте выбора разница вышла в пять раз.
Удивительно.

Спасибо!!!

Новые блоги и статьи Все статьи Все блоги /
Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм anaschu 30.08.2026 Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .	Оттачиваю умение писать js программы. russiannick 30.08.2026 Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .	мат медиц модель 30. презентация проекта anaschu 27.08.2026 хоп хоп хоп хидахоп, а я кладую))	Как у меня протекала болезнь zorxor 27.08.2026 Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .

@Capi Модератор 6231 / 2909 / 707 Регистрация: 12.06.2016 Сообщений: 7,839
	23.02.2018, 23:49
	Все выборки учтены в уже показанной мною единственной строке. Вы, кстати, внесли ошибку в предложенное выражение. Сейчас не буду вдаваться в подробности - пишу с планшета. Потом. И не забывайте о спасибо. 1

@glsn 604 / 127 / 45 Регистрация: 12.04.2015 Сообщений: 519
	24.02.2018, 00:13 [ТС]
	да, но возможен ли полный код? не совсем я все понял просто Добавлено через 7 минут если говорить о единственном варианте - то, Ваш код работает, но только при выборе поля поиска cboSearch на позицию 1 - для поля FIO, а критерия поиска совпадения cboSvp в позиции - 0. Но в проекте то предполагается, что мы будем их менять перебирая варианты поиска и полей для поиска. Следовательно получается нужно прописывать строки для каждого случая перебора? не совсем понимаю.. 0

@Capi Модератор 6231 / 2909 / 707 Регистрация: 12.06.2016 Сообщений: 7,839
	24.02.2018, 01:04
	Eugene-LS, Спасибо. Но что-то мне Choose(l, не нравится в 30-й строке. Завтра попробую по-своему сделать. Сообщу. 0

@Capi Модератор 6231 / 2909 / 707 Регистрация: 12.06.2016 Сообщений: 7,839
	24.02.2018, 01:38
	Почти в семь раз? Интересно... Спокойной ночи. До завтра. 1

@Capi Модератор 6231 / 2909 / 707 Регистрация: 12.06.2016 Сообщений: 7,839
	24.02.2018, 11:04
	glsn, Спасибо за пред-поздравление!!!))) Что касается улучшений. На мой взгляд, cboSvp и cboSearch лучше иметь значения (1, 2), а не (0, 1). Тогда не нужно будет прибавлять им единицу в Choose. 1

@Capi Модератор 6231 / 2909 / 707 Регистрация: 12.06.2016 Сообщений: 7,839
	24.02.2018, 16:15
	Eugene-LS, Скорости Select Case и Choose сравнила. По-своему. Но результат аналогичный. Более того, при увеличении числа вариантов выбора разница в скорости существенно растет. Конечно, в пользу Select Case. И даже при единственном варианте выбора разница вышла в пять раз. Удивительно. Спасибо!!! 0