Доброго всем вечера! Избитая, кажется, тема, но уже много источников просмотрела и никак не могу найти простого ответа - все с какими-то хитростями и сложностями. Нужен Combobox с поиском значений по нескольким введенным символам, которые могут находиться в любой части значения (в начале, в конце, в середине), никаких дополнительных элементов на форме размещать по задаче нельзя (видела решения с Listbox), никаких данных из других столбцов подхватывать не нужно тоже (видела решение по двум столбцам - слишком много и сложно и с сортировкой - не смогла разобраться, чтобы адаптировать под себя). По итогам поиска на форме должен быть открыть список с найденными значениями, то есть список на основании первоначального (включающего в себя все возможные записи), сокращенный до того числа значений, в которых встретились вводимые символы. Подскажите, где можно подсмотреть такое решение? Или подскажите, пожалуйста, чего в моём коде не хватает, чтобы он заработал?
Юрий, не так - этот вариант я видела, он работает с двумя столбцами и сортирует данные - слишком наворочен и выбрать из него нужное для моей задачи у меня не получается. Видела простые решения с Listbox, попыталась сделать по образу и подобию с Combobox, но не выходит.
Ааааааааааааа, сама с собой поговорила и, кажется, дошло! Нужно перебирать варианты без звездочек впереди и в конце и всё переводить к единому регистру букв! Юрий М, не видела Вас сегодня, но спасибо
Андрей VG написал: Вариант с использованием ADODB.Recordset
Андрей VG, добрый день. При поиске выдает корректные результаты, но при попытке перехода по списку с помощью стрелок на клавиатуре, в списке просто выбирается первое значение. Не знаете как решить эту проблему? Чтобы при использовании стрелок был просто переход по найденным значениям списка?
Вы бы могли попробовать этот путь: (Замените следующую процедуру "cmbNames_Change")
Код
Private Sub cmbNames_Change()
Dim sText As String
Static stoy As Boolean
sText = Trim$(cmbNames.Value)
cmbNames.DropDown
If stoy Then
If sText = "" Then stoy = False: GoSub abcdefg
Exit Sub
End If
If Len(sText) = 0 Then
GoSub abcdefg
Else
cmbSource.Filter = "names Like '*" & sText & "*'"
If cmbSource.RecordCount > 0 Then
stoy = True
cmbSource.MoveFirst
cmbNames.Column = cmbSource.GetRows
Else
cmbNames.List = Array("[не найдено соответствия]")
End If
End If
Exit Sub
abcdefg:
cmbSource.Filter = ""
cmbSource.MoveFirst
cmbNames.Column = cmbSource.GetRows
Return
End Sub
, но я не знаю, будет ли Андрей VG доволен таким решением ... : ) ...
ocet p, спасибо. В вашем варианте почему-то поиск останавливался после ввода первой буквы. Немного изменил код (скорее всего не очень красиво сделал), вроде все получилось. Выкладываю итоговый файл. Если кто-нибудь знает как сюда прикрутить вывод в ComboBox только уникальных значений, да и по алфавиту, то думаю получится хороший инструмент.
lis2109 написал: почему-то поиск останавливался после ввода первой буквы
Код был адаптирован к этому:
Цитата
lis2109 написал: при попытке перехода по списку с помощью стрелок на клавиатуре, в списке просто выбирается первое значение
, не для ручного ввода данных. Код содержит строку (cmbSource.Filter = "names Like '*" & sText & "*'"), отвечающую за фильтрацию введенного текста, которую необходимо изменить/настроить/записать по-другому, и так далее ... или изменить что-то в коде в другом месте, чтобы получить то, что вы хотите.
Сортер с удалением дубликатов + пустых значений с примером использования (хотя у Recordset'а вроде есть свой встроенный сортер):
Код
Sub test()
ReDim arr(1 To 100)
For a = 1 To UBound(arr)
arr(a) = Int(Rnd * UBound(arr))
Next
ArrSort arr
End Sub
'-------------
Sub ArrSort(arr())
Dim DC As Object, cc(), dd(), a&, b&
If UBound(arr) + 1 - LBound(arr) + 1 = 1 Then Exit Sub
Set DC = CreateObject("Scripting.Dictionary")
For a = LBound(arr) To UBound(arr)
If Len(arr(a)) > 0 Then b = b + 1 Else c = c + 1
Next
If b > 0 Then ReDim cc(1 To b): b = 0
For a = LBound(arr) To UBound(arr)
If Len(arr(a)) > 0 Then b = b + 1: cc(b) = arr(a)
Next
If b > 0 Then
ReDim dd(1 To b): dd(1) = cc(1)
For a = 2 To UBound(cc)
b = a
Do While dd(b - 1) > cc(a)
dd(b) = dd(b - 1): b = b - 1
If b = 1 Then Exit Do
Loop
dd(b) = cc(a)
Next
For a = 1 To UBound(dd)
If Not DC.exists(dd(a)) Then DC.Add dd(a), 0
Next
arr = DC.keys
End If
End Sub
... и может проверьте ещё одну модификацию кода Андрея VG, как она у вас срабатывает ...
Код
Private Sub cmbNames_Change()
Dim indks As Long
Dim sText As String
sText = Trim$(cmbNames.Value)
indks = cmbNames.ListIndex
If Len(sText) = 0 Then
cmbSource.Filter = ""
Else
If indks = -1 Then cmbSource.Filter = "names Like '*" & sText & "*'"
End If
If cmbSource.RecordCount = 0 Then
cmbNames.List = Array("[не найдено соответствия]")
Exit Sub
End If
cmbSource.MoveFirst
cmbNames.Column = cmbSource.GetRows
cmbNames.DropDown
End Sub
Здравствуйте! Ребята, подскажите, как можно применить код Андрей VG с использованием ADODB.Recordset.для нескольких комбобоксов? Для меня это совсем новое (ADODB.Recordset), не знаю, как с ним боротся. И, когда я вставляю весь код Андрей VG вместо своего, у меня макрос ругается на "cmbSource As New ADODB.Recordset". Хотеось, бы конечно связать этот код ещё с сортировкой данных для комбобокса, как в моём примере.
Друзья , пригодился мне Ваш combobox с поиском , не могли бы Вы еще подсказать, как сделать так чтобы результат поиска добавлялся не в активную ячейку, а в конкретную например B17? пример во вложении )))