Выпадающий список с поиском

[staniiislav]

Можно еще один вопрос
Можно ли при стандартном выпадающем списке как в примере, добавить код, при котором будет выполнятся действие, при нажатии на ячейку со списком (1-н раз лев. кнопкой мыши), допусти я ну буду выбирать значения со списка, а хочу ввести это значение с клавиатуры (заранее я помню какие есть значения в списке), и при нажатии на первую буква, список предлагал первое найденное совпадение по первому символу (и в самом списки перемещался к это первому найденному значению).
Что именно меня интересует (исходя из примера), если допустим в ячейку с2 ввести с клавиатуры первую букву "d", происходило следующее, в ячейки появлялось значение из списка "dfgdg" (ячейка К20), и если много значений на букву "d", то нажимаем на стрелочку выпадающего списка (ячейки в которую ввели "d") и в выпадающем списки отображалось это первое совпадение по букве "d", а не начало списка.
Такое возможно сделать?
Саму идею я взял вот из этого примера. Посмотрите пожалуйста.
Спасибо.

Еще оно, вообщем я хотел бы чтобы стандартный выпадающий список эксель, работал на подобе jQuery Autocomplete.
Такое возможно, кто не будь такое делал?

[and150382]

Помогите пожалуйста!
Нужно добавить в макрос функцию поиска по первым буквам. Чтобы я начал набирать фамилию, а она сортировалась в списке. Потом после выбора фамилии она добавлялась в ячейку. Список будет большой.Макрос у меня в колонке H, а мне нужно еще в колонки J , R , V . Помогите пожалуйста, уже неделю сижу и ничего не получается.

[and150382]

Получилось сделать в нескольких столбцах

Как сделать поиск? Помогите с ответом


Private Sub Worksheet_Change(ByVal Target As Range)

Dim lReply As Long, i As Integer
Dim counter As Integer, MyName As String, NameRange As String

If Target.Cells.Count > 1 Then Exit Sub
If Target.Column = "8" Then
If IsEmpty(Target) Then Exit Sub
counter = Len(Target)
MyName = Left(Target, counter)
For i = 1 To Range("People").Count
NameRange = Left(Range("People").Cells(i), counter)
If LCase(NameRange) = LCase(MyName) Then
Application.EnableEvents = False
Application.EnableEvents = True
Exit For
End If
Next
If WorksheetFunction.CountIf(Range("Pe ople"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People").Cells(Range("People ").Rows.Count + 1, 1) = Target
Range("People").Resize(Range("Peopl e").Rows.Count + 1).Name = "People"
Range("People").Sort Key1:=Range("AD12"), _
Order1:=xlAscending, Header:=xlNo
Else
Target = ""
End If
End If
End If

If Target.Column = "10" Then
If IsEmpty(Target) Then Exit Sub
counter = Len(Target)
MyName = Left(Target, counter)
For i = 1 To Range("People").Count
NameRange = Left(Range("People").Cells(i), counter)
If LCase(NameRange) = LCase(MyName) Then
Application.EnableEvents = False
Application.EnableEvents = True
Exit For
End If
Next
If WorksheetFunction.CountIf(Range("Pe ople"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People").Cells(Range("People ").Rows.Count + 1, 1) = Target
Range("People").Resize(Range("Peopl e").Rows.Count + 1).Name = "People"
Range("People").Sort Key1:=Range("AD12"), _
Order1:=xlAscending, Header:=xlNo
Else
Target = ""
End If
End If
End If

If Target.Column = "18" Then
If IsEmpty(Target) Then Exit Sub
counter = Len(Target)
MyName = Left(Target, counter)
For i = 1 To Range("People").Count
NameRange = Left(Range("People").Cells(i), counter)
If LCase(NameRange) = LCase(MyName) Then
Application.EnableEvents = False
Application.EnableEvents = True
Exit For
End If
Next
If WorksheetFunction.CountIf(Range("Pe ople"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People").Cells(Range("People ").Rows.Count + 1, 1) = Target
Range("People").Resize(Range("Peopl e").Rows.Count + 1).Name = "People"
Range("People").Sort Key1:=Range("AD12"), _
Order1:=xlAscending, Header:=xlNo
Else
Target = ""
End If
End If
End If

If Target.Column = "22" Then
If IsEmpty(Target) Then Exit Sub
counter = Len(Target)
MyName = Left(Target, counter)
For i = 1 To Range("People").Count
NameRange = Left(Range("People").Cells(i), counter)
If LCase(NameRange) = LCase(MyName) Then
Application.EnableEvents = False
Application.EnableEvents = True
Exit For
End If
Next
If WorksheetFunction.CountIf(Range("Pe ople"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & _
Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
Range("People").Cells(Range("People ").Rows.Count + 1, 1) = Target
Range("People").Resize(Range("Peopl e").Rows.Count + 1).Name = "People"
Range("People").Sort Key1:=Range("AD12"), _
Order1:=xlAscending, Header:=xlNo
Else
Target = ""
End If
End If
End If
End Sub

[staniiislav]

посмотрите два варианта, может подойдут... макросы писал не я, я только их переделал немного

[and150382]

Спасибо большое!!!!!
Очень помогли