ComboBox умеет предлагать список похожих вариантов?

[Евгений ГВС]

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

Обработка событий теперь осуществляется одной строкой для всех элементов управления:

Если не затруднит, можно описать этот прием без привязки к конкретному примеру?

[jobsap21]

Здравствуйте!

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

Сразу спешу предупредить, что все же один недочет остаётся: стрелки на клавиатуре вверх и вниз будут приводить к попаданию в комбу первого значения из списка. Но, если приучить пользователей выбирать необходимый вариант мышкой - механизм вполне срабатывает.

Public client, rez, p As Boolean, r, nf&
-----------------------------------------

Private Sub UserForm_Initialize()

' при открытии формы загружаем в комбу необходимый список

client = Sheets("Клиенты").[Клиенты]
With cb
.List = client
End With

End Sub
-----------------------------------------
Private Sub cb_Change()

Dim s, r&, n&

client = Sheets("Клиенты").[Клиенты]

Application.ScreenUpdating = True

If cb.Text = "" Then cb.List = client

s = UCase(cb.Text)
a = Len(s)

If a = 0 Then GoTo finishSub

rez = Application.Transpose(client) ' копируем весь массив в rez
nf = UBound(client)

For Each s In Split(s, "")
For r = 1 To nf 'бежим по массиву rez , ищем вхождения
If UCase(rez(r)) Like "*" & s & "*" Then
n = n + 1
rez(n) = rez(r) ' если есть вхождение, то записываем его в rez же, затирая ненужную информацию
End If
Next
If n > 0 Then
nf = n
n = 0
Else
Exit For
End If
Next

If nf = 0 Then nf = 1

ReDim Preserve rez(1 To nf)

Application.EnableEvents = False

With cb
.MatchEntry = 2
.List = rez ' заносим найденное в комбо
.AutoWordSelect = True
.AutoSize = False
.DropDown ' распахиваем комбо
End With

finishSub:

Application.EnableEvents = True

End Sub

-----------------------------------------
Private Sub CmdButt_AddNewNote_Click()
' при нажатии на кнопку, к примеру, добавление новой записи в отчет
' загружаем в комбу ПОЛНЫЙ первоначальный список
client = Sheets("Клиенты").[Клиенты]

With cb
.List = client
End With
' запоминаем индекс списка и прибаляем - если надо - количество строк
' смещения нахождения нашего списка на листе источнике
b = (cb.ListIndex + 1) + 2
' фиксируем необходимое значение из листа источника
с = Sheets("Клиенты").Cells(b, 9).Value
'вставляем, куда требуется
ActiveCell.Value = с

End Sub