Выпадающий список с поиском в Экселе.

Привет!

В Одессе сильная жара, и меня ждет море. Море работы. Я разработал такой вот выпадающий список с поиском -- как в Гугле -- для Экселя.

Если ты не знаешь, что такое выпадающие списки, не беда. В Экселе их можно найти по адресу:
Данные → Проверка данных... Выбор значений из списка.

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

Чего склонен ожидать пользователь от такого списка?

1. При вводе любого символа с клавиатуры список сокращается до тех значений, которые отвечают введенному критерию-символу. Это сделать нельзя.
2. Ну хотя бы при вводе первого символа, чтобы список прокручивался до слов, начинающихся с той буквы, которую ты ввел. Нет, так сделать тоже нельзя.

Предлагаю решение, которое поможет тебе справляться с большими списками. Решение использует VBA с использованием пользовательской формы. Далее я пошагово расскажу, как у себя настроить то же. Но сперва предлагаю скачать пример с готовым фильтром, на базе которого ты можешь настроить свой шаблон.

Немного кода...

Работаем в редакторе VBA. Если ты раньше там не бывал, не бойся. В этом нет ничего страшного!

Нажми [Alt] + [F11] для открытия редактора кода. Интерфейс его весьма приятный, он не менялся, наверное, уже лет 20. Слева нажми правой кнопкой мыши по элементам текущей книги и нажми Insert > Module.

Итак, в обычный модуль добавь следующий код:

Option Explicit
Const minW = 170
Const minH = 15
Public NamedRange       As String
Public LinkedCell       As Range
Public List             As Range
Public L                As Long
Public T                As Long
Public W                As Long
Public H                As Long
Public CodeChange       As Boolean


Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hwnd As Long) As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Const HWND_DESKTOP As Long = 0
Private Const LOGPIXELSY As Long = 90
Private Const LOGPIXELSX As Long = 88

Const TWIPSPERINCH = 1440

Private Declare Function SystemParametersInfo Lib "user32" _
      Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, _
      ByVal uParam As Long, _
      lpvParam As Any, _
      ByVal fuWinIni As Long) As Long

Sub ShowForm()
    If UserForm1.Caption = "UserForm1" Then _
    UserForm1.Show ' show the form
End Sub

Sub ButtonLaunch()
' Change Range(...) to yours
Dim Target      As Range
On Error Resume Next
Set Target = ActiveCell
If Intersect(Target, Range("B4:B500")) _
    Is Nothing Or Target.Cells.Count > 1 Then
    Exit Sub
End If
SetList
Call DetectDimentions(Target)
Call SetLinkedCell(Target)
ShowForm
End Sub

Sub DetectDimentions(Ran As Range)
Dim S       As Shape
Dim C       As Range
Dim TwX     As Long
Dim TwY     As Long
Dim CorrX   As Long
Dim CorrY   As Long
Dim ScrRow  As Long
Dim ScrCol  As Long
Dim Cls     As Range
Dim Ros     As Range
Dim Zoom    As Integer

TwX = TwipsPerPixelX
TwY = TwipsPerPixelY
Set C = Cells(1, 1)
Set S = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 1, 1)
S.Top = C.Top
S.Left = C.Left

' find correction
Zoom = ActiveWindow.Zoom
ActiveWindow.Zoom = 100
ScrRow = ActiveWindow.ScrollRow
ScrCol = ActiveWindow.ScrollColumn
If ActiveWindow.ScrollRow > 1 Then
Set Cls = Range(Cells(1, 1), Cells(ScrRow - 1, 1))
CorrY = Cls.Height * 20 / TwX
End If
If ActiveWindow.ScrollColumn > 1 Then
Set Ros = Range(Cells(1, 1), Cells(1, ScrCol - 1))
CorrX = Ros.Width * 20 / TwX
End If

With ActiveWindow
    L = .PointsToScreenPixelsX(S.Left) + CorrX
    T = .PointsToScreenPixelsY(S.Top) + CorrY
End With
ActiveWindow.Zoom = Zoom
L = L * TwX / 20
T = T * TwY / 20

With Ran
    W = .Width
    If W < minW Then W = minW
    H = .Height
    If H < minH Then H = minH
End With

S.Delete

End Sub

Sub SetLinkedCell(Target As Range)
    Set LinkedCell = Target
End Sub

Sub SetList()
NamedRange = "Regions"
On Error Resume Next
    Set List = Range(NamedRange)
If Err.Number <> 0 Then
    MsgBox "Диапазона [" & NamedRange & "] не существует =("
    End
End If
End Sub

Public Function InList(Find As String, List As Range)
    InList = Application.Match(Find, List, 0)
    If IsError(InList) Then InList = False
End Function


Sub PopulateList(CB As MSForms.ListBox, List As Range, CBval As String)
    Dim Cel     As Range
    CB.Clear
    If CBval = "" Or InList(CBval, List) Then
        For Each Cel In List
            CB.AddItem Cel
        Next Cel
    Else
        CBval = UCase(CBval)
        For Each Cel In List
            If InStr(1, UCase(Cel), CBval) Then _
                CB.AddItem Cel
        Next Cel
    End If
End Sub

Sub RemoveCaption(objForm As Object)
     
    Dim lStyle          As Long
    Dim hMenu           As Long
    Dim mhWndForm       As Long
     
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
    Else
        mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
    End If
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
     
End Sub

Public Function TwipsPerPixelX()
  Dim lngDC As Long
 
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelX = TWIPSPERINCH / GetDeviceCaps(lngDC, LOGPIXELSX)
  ReleaseDC HWND_DESKTOP, lngDC
End Function
 
Public Function TwipsPerPixelY()
  Dim lngDC As Long
 
  lngDC = GetDC(HWND_DESKTOP)
  TwipsPerPixelY = TWIPSPERINCH / GetDeviceCaps(lngDC, LOGPIXELSY)
  ReleaseDC HWND_DESKTOP, lngDC
End Function

В этом коде найди строку NamedRange = "Regions" и слово Regions замени на свой диапазон. Это может быть адрес диапазона, например "Лист1!A1:A200", это может быть имя диапазона, как в моем случае.
Так же в строке If Intersect(Target, Range("B4:B500")) тебе нужно поставить свой диапазон, в котором требуется создать выпадающие списки. Для этого замени B4:B500 на адрес своего диапазона. Этот адрес может не содержать имени листа, т.к. всегда используется текущий лист.

Дальше нужно вставить форму с двумя элементами управления: TestBox и ListBox.


Там же в редакторе кода вставляешь форму: Insert > UserForm. И на нее простыми кликами мыши переносишь TestBox и ListBox. Ты их можешь разместить как угодно. При запуске формы мы их разместим правильно.

Теперь пора вставлять код формы. Выдели саму форму и нажми [F7]. Это перенесет тебя в окно с кодом самой формы. В это окно вставь код:

Const ListBoxH = 100
Option Explicit
Private Sub ListBox1_Change()
If ListBox1.ListIndex > -1 Then
    If ListBox1.Value <> TextBox1.Value Then
        CodeChange = True
        TextBox1.Value = ListBox1.Value
    End If
End If
End Sub
Sub EndForm()
    LinkedCell = ListBox1.Value
    Unload Me
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    EndForm
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 13
    EndForm
Case 38
    If ListBox1.ListIndex = 0 Then TextBox1.SetFocus
End Select
End Sub

Private Sub TextBox1_Change()
If CodeChange Then
    CodeChange = False
Else
    LinkedCell.Value = TextBox1.Value
    Call PopulateList(UserForm1.ListBox1, List, TextBox1.Value)
End If
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 18
    ListBox1.Value = ""
Case 40
    If ListBox1.ListCount > 0 Then
        ListBox1.ListIndex = 0
        ListBox1.SetFocus
    End If
End Select
End Sub

Private Sub UserForm_Terminate()
    If InList(LinkedCell.Value, List) = False Then
        LinkedCell.Value = ""
    End If
End Sub
Private Sub UserForm_Initialize()
    Call RemoveCaption(Me)
End Sub
Private Sub UserForm_Activate()
    With UserForm1
        .Top = T
        .Left = L
        .Width = W + 4
        .Height = H + ListBoxH - 4
    End With
    With ListBox1
        .Top = H
        .Left = 0
        .Width = W
        .Height = ListBoxH
    End With
    With TextBox1
        .Top = 0
        .Left = 0
        .Width = W
        .Height = H + 5
        .Value = LinkedCell.Value
    End With
    If LinkedCell.Value = "" Then _
    Call PopulateList(UserForm1.ListBox1, List, TextBox1.Value)
End Sub   

Дальше ты почти готов к использованию списков с поиском. Тебе нужно создать сам список, из которого будут выпадать значения. Теперь стань в любую ячейку, которая находится внутри целевого диапазона и нажми [Alt] + [F8]  и в списке макросов найди и запусти макрос: ButtonLaunch.


И еще для удобства пользования ты можешь привязать макрос, который запускает код к кнопке или картинке.

И еще ты можешь заставить код срабатывать автоматически. Для этого в код целевого листа вставь следующее:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Change Range(...) to yours
If Target.Columns.Count > 1 Then Exit Sub
If Target.Rows.Count > 1 Then Exit Sub
If Intersect(Target, Range("B4:B500")) Is Nothing Then
    Exit Sub
End If
SetList
Call DetectDimentions(Target)
Call SetLinkedCell(Target)
ShowForm
End Sub
 

В этом последнем коде так же замени диапазон. В строке If Intersect(Target, Range("B4:B500")) тебе нужно поставить свой диапазон, в котором требуется создать выпадающие списки. Для этого замени B4:B500 на адрес своего диапазона.



***
Сложно мне было достичь такого результата... Что я только не перепробовал, пока не пришел к такому решению. И оно, разумеется, не идеально...

Привет разработчикам

В Экселе, оказывается, не все так просто, как на самом деле. При разработке данного проекта я пробовал использовать следующие средства:

Элементы ActiveX. 
Результат: работают они красивее, чем формы, к тому же они самостоятельны (не привязаны к оболочке) и являются  частью рабочего пространства т.е. ячеек Экселя. Поэтому связанные списки у меня появлялись прямо в ячейках. Но при работе с ActiveX, оказалось, что они сплошь глючные, иногда неадекватно показывают событие выпадения самого списка. И когда, преодолев все сложности, я дописал код, оказалось, что он работает нестабильно. На более слабой машине, чем моя, Эксель пока последней 2013 версии вылетал каждый раз при попытке создания списка.

Элементы управления формы.
Они, как я узнал на одном из форумов, более приятны в обращении, но оказалось, что выпадающий список форм не обладает всем функционалом, который мне был необходим. Так что это пока отпадает.


Выпадающий список в форме.
Это уже ближе. С формой у меня есть отдельная боль -- ее очень нелегко разместить в нужном месте экрана, на что ушло процентов 80 всего кода и столько же усилий. Но главное, что выпадающий список в стандартной форме Экселя тоже работал глючно. А именно, при попытке заставить его выпадать, он часто выдавал непредсказуемый результат на экран.


Сочетание элементов управления в форме.
Наконец, я пришел к двум связанным элементам формы, которые симулируют один выпадающий список, а именно это простое текстовое поле (TestBox) и простой список(ListBox). Именно этот вариант привел меня к решению.

Решение это мне не нравится до сих пор: уж слишком оно громоздкое и неизящное. Слишком много усилий ради такой простой функции. Что ж, будем искать еще варианты. Но, тем не менее, приведенное выше решение работает стабильно и не приводит к перезагрузке программы (надеюсь, что это так). Поэтому предлагаю тебе адаптировать его.

Идея!

И тут, при написании этой статьи, ко мне пришла идея: а что если использовать смешанную технику для нахождения более изящного решения.

В примере выше, который я как раз закончил делать, ты видишь динамический список, который появляется непосредственно на месте ячейки, которую мы форматируем. Замечу несколько моментов:

1. Во-первых, качай пример себе и тестируй, адаптируй, развивай.
2. Второе. Как его адаптировать. В коде листа есть обработчик событий, и в нем нужно заменить во второй строке Const DropDownRange = "B4:B500" на свой диапазон. С этим проблем не должно возникнуть. Дальше в модуле есть код, который обрабатывает большинство вещей. В нем ты тоже замени кое-что, а именно в строке Public Const NamedRange = "Regions" поменяй "Regions" на полный адрес диапазона со значениями для проверки. Тут удобнее использовать именованный диапазон, как в моем примере, но можно и прописать полный адрес, например Лист1!А1:А25
3. Третье. Данным списком удобно пользоваться. Он работает шустро. Он отвечает на некоторые события: после редактирования текста меняется список, это само собой. Но еще ты можешь после ввода чего-нибудь нажать на стрелки Вниз - Вверх, при этом выделятся значения внутри списка, и потом нажать [Tab] или [Enter] ввести выбранное значение. Это, по-моему, совпадает с ожидаемым поведением элементов управления. Тут пока есть небольшая недоработка, которую ты легко заметишь, протестировав пример. А именно если в текстовое поле ничего не введено, то оно не реагирует на нажатие стрелок. Но с этим можно жить, а к тому же, думаю, пытливый ум найдет решение.
4. Данный список не проверяет жестко введенный текст в ячейку, но с этим можно легко справиться, например, дополнительно сделав проверку данных по диапазону.

Это решение, по-моему, максимально отвечает поставленной задаче. Тут есть еще простор для улучшений, но начало задано. Смысл работы основывается на нескольких идеях:

Идея первая. Сделай качественную подделку.
Можно подделать элементы управления, если их создавать прямо сверху ячейки, которую выделил пользователь.

Идея вторая. Использовать элементы ActiveX и элементы формы
Ввиду множества проделанных неудачных опытов, я пришел к выводу, что напрямую добиться результата нельзя. Но можно отдельно использовать элемент со списком ListBox, и элемент поле TextBox, и заставить из совместно работать как ComboBox -- выпадающий список. Повторюсь, что напрямую это сделать я не смог -- уж очень много глюков обнаружилось. И вот я в решении соединил 2 элемента управления, причем один из них -- ActiveX (поле), а второй -- элемент формы (список). Это дало более стабильный результат, но при этом изящный и более легковесный, чем решение с пользовательскими формами. К тому же мне повезло найти пример с обработкой нажатия пользователем кнопок (KeyCode) при изменении Поля TextBox. Это дало возможность сделать список более дружелюбным к действиям пользователя.

Идея третья. Что еще можно сделать
Еще можно сделать так, чтобы пользователь смог вручную отключать опцию выпадения списка. Дело в том, что это может быть слишком навязчиво и неудобно при форматировании таблицы в целом. Тут оставляю пробел и специально не дорабатываю код: это довольно просто сделать и способов множество, так что оставляю эту работу за тобой.

И еще, разумеется, можно повысить дружелюбность списков, и добавить жесткую проверку данных, которая не даст ошибиться при вводе. Но это потом.




***
Скоро будут выходные, и я хочу все-таки пойти на море. Поэтому закругляюсь.