Страницы: 1
RSS
Combobox с поиском, VBA
 
Доброго всем вечера!
Избитая, кажется, тема, но уже много источников просмотрела и никак не могу найти простого ответа - все с какими-то хитростями и сложностями.
Нужен Combobox с поиском значений по нескольким введенным символам, которые могут находиться в любой части значения (в начале, в конце, в середине), никаких дополнительных элементов на форме размещать по задаче нельзя (видела решения с Listbox), никаких данных из других столбцов подхватывать не нужно тоже (видела решение по двум столбцам - слишком много и сложно и с сортировкой - не смогла разобраться, чтобы адаптировать под себя).
По итогам поиска на форме должен быть открыть список с найденными значениями, то есть список на основании первоначального (включающего в себя все возможные записи), сокращенный до того числа значений, в которых встретились вводимые символы.
Подскажите, где можно подсмотреть такое решение?
Или подскажите, пожалуйста, чего в моём коде не хватает, чтобы он заработал?
Изменено: LiSSa - 16.04.2016 19:59:09
В полете голова - важнее крыльев
 
Как-то так :D
 
Юрий, не так - этот вариант я видела, он работает с двумя столбцами и сортирует данные - слишком наворочен и выбрать из него нужное для моей задачи у меня не получается. Видела простые решения с Listbox, попыталась сделать по образу и подобию с Combobox, но не выходит.
В полете голова - важнее крыльев
 
Ааааааааааааа, сама с собой поговорила и, кажется, дошло!
Нужно перебирать варианты без звездочек впереди и в конце и всё переводить к единому регистру букв!
Юрий М, не видела Вас сегодня, но спасибо :)
Изменено: LiSSa - 16.04.2016 20:38:09
В полете голова - важнее крыльев
 
Доброе время суток
Вариант с использованием ADODB.Recordset.
Успехов.
 
Цитата
LiSSa написал: Юрий М, не видела Вас сегодня
Это как, если я смотрю тему? ))
Вот ещё вариант, но без приведения к единому регистру. Добавите сами?
 
Как сразу жизнь наладилась :)
Андрей VG, спасибо, не все знакомо, но работает как нужно!
Юрий М, с UCase или LCase уже справлюсь. Спасибо! :)
В полете голова - важнее крыльев
 
Только в моём варианте желательно непустые значения переложить в другой массив и уже его скормить КомбоБоксу )
 
Цитата
Юрий М написал:
непустые значения переложить в другой массив
Это чтобы открытый список сократился до числа непустых элементов?
Сейчас данные фильтруются, но в нижней части списка висит пустота.
В полете голова - важнее крыльев
 
Цитата
LiSSa написал:
Это чтобы открытый список сократился до числа непустых элементов?
Именно )
 
Чувствую себя героем и от гордости за не совсем потерянный мозг - прёт.
Съем лимон и пойду спать. )))
Еще раз СПАСИБО!  
В полете голова - важнее крыльев
 
Цитата
Андрей VG написал: Вариант с использованием ADODB.Recordset
Андрей VG, добрый день.
При поиске выдает корректные результаты, но при попытке перехода по списку с помощью стрелок на клавиатуре, в списке просто выбирается первое значение. Не знаете как решить эту проблему? Чтобы при использовании стрелок был просто переход по найденным значениям списка?
Изменено: lis2109 - 09.02.2019 19:13:45
 
Вы бы могли попробовать этот путь:
(Замените следующую процедуру "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 - 09.02.2019 22:40:48
 
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
Изменено: Anchoret - 10.02.2019 16:56:16
 
... и может проверьте ещё одну модификацию кода Андрея 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". Хотеось, бы конечно связать этот код ещё с сортировкой данных для комбобокса, как в моём примере.

Спасибо!
 
Макрос Андрей VG почему-то не запускается на моём примере:
 
Друзья , пригодился мне Ваш combobox с поиском , не могли бы Вы еще подсказать, как сделать так чтобы результат поиска добавлялся не в активную ячейку, а в конкретную например B17? пример во вложении )))
 
Найти в коде слово ActiveCell, и заменить на конкретную ячейку, например [B17].
 
Благодарю)
Страницы: 1
Наверх