Пометка элементов списка

Постановка задачи

Имеем на листе список чего-либо. Хотелось бы использовать привычные флажки-чекбоксы или жирные точки-переключатели для отмечания выбранных элементов. Примерно так:

checkboxes-animate.gif

Решение

Щелкните правой кнопкой мыши по ярлычку листа, где находится список, и выберите в контекстном меню Исходный текст (Source Code). Вы должны попасть в редактор Visual Basic.

Скопируйте туда этот код:

'Ставим флажок, если был одиночный щелчок по ячейке
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
            Application.EnableEvents = False
            Target.Font.Name = "Marlett"
            Target = "a"
            Application.EnableEvents = True
        End If
End Sub 

'Снимаем флажок, если был двойной щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
        Application.EnableEvents = False
        Cancel = True
        Target.ClearContents
        Application.EnableEvents = True
    End If
End Sub

Первая половина кода проверяет, не было ли одиночного щелчка по ячейкам в диапазоне A2:A100 и если был - то ставит "галочку" - знак, который в шрифте Marlett находится на букве "а". Вторая половина этого кода снимает флажок при двойном щелчке по ячейке. При необходимости замените в этом коде "A2:A100" на Ваш диапазон.

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

=СЧЁТЕСЛИ(A2:A100;"a")

 =COUNTIF(A2:A100;"a") 

Если надо, чтобы пользователь мог пометить только один элемент из списка, то код упрощается – достаточно всего одного макроса:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
            Application.EnableEvents = False
            Range("A2:A100").ClearContents
            Target.Font.Name = "Marlett"
            Target = "h"
            Application.EnableEvents = True
        End If
End Sub

Этот макрос сначала полностью очищает наш столбец А, а потом вводит в текущую ячейку букву "h", которая в шрифте Marlett даст нам характерный символ выбора по типу "один-из" – жирную точку. Два таких символа поставить, таким образом, не получится – доступен будет только выбор одного элемента из списка. Чтобы извлечь выбранный элемент, можно использовать стандартную функцию ВПР (VLOOKUP), которая будет искать символ точки (т.е. букву "h") в первом столбце нашей таблицы и, найдя, выдавать фамилию из второго:

checkboxes2.png

Ссылки по теме



Иван
14.10.2012 23:33:27
А как можно запретить в определенных ячейках проставлять галочку, скажем, "А9", "А23"?
14.10.2012 23:36:31
Чувствительный диапазон может быть задан и несмежными областями, т.е. за исключением заданных ячеек - например так:
Range("A2:A10,A12:A100") - ячейка А11 исключается
06.02.2019 11:31:47
а как сделать так, чтобы исключались ячейки в зависимости от содержимого смежных ячеек ?
Например:
если в ячейках столбце К есть данные, то в этих строках столбца L галки запрещены
14.02.2013 00:42:05
Как сделать тоже, только на 2 столбика или 3
18.02.2013 12:43:13
А в чем проблема? Чувствительный диапазон может и на 2 столбца и на 3 распространяться - см. предыдущий комментарий.
08.05.2013 15:45:32
Долго искал как можно это реализовать и раньше вбивал "а" данным шрифтом вручную! :) Спасибо!

Николай, а как возможно автоматически сортировать таблицу по столбцу с флажком, так чтобы они оказывались в конце списка? Просто пустые ячейки не сортируются, возможно туда стоит вставлять бесцветный символ? Буду признаетелен, если подскажите как это возможно сделать!
08.05.2013 16:18:46
Максим, можно сделать сортировку по своему нестандартному списку. Данные - Сортировка - в третьем выпадающем списке выбрать не "А-Я", а "Пользовательский список" и ввести новый список с одной буквой "а". Сортировка по убыванию по данному списку по столбцу с галками должна "выдавить" все строки с галочками в конец списка.
14.06.2013 17:33:31
Добрый день Николай!
Пользуюсь данным кодом, все отлично, но появилась необходимость в некоторых дополнениях.
Подскажите пожалуйста, какое максимальное количество диапазонов можно применить в данном коде и есть ли такая возможность сделать так, чтобы в некоторых диапазонах можно было ставить только один флажок?
11.12.2013 12:11:05
Денис, дописал к статье второй вариант - чтобы можно было выбрать только один пункт из списка.
10.08.2013 18:13:03
В развитие данного макроса.
Можно ли сделать так, чтобы при внесении "крыжиков", в этой же строке, в "энной" ячейке, автоматически проставлялась дата (день, месяц, год) внесения "крыжика".
16.09.2013 12:53:51
Николай, здравствуйте!
Подскажите, как сделать такой "крыжик" блокировкий?
Я имею ввиду если он ставится то все ячейки строки слева от него блокируются паролем и крыжик снять можно так же только с паролем.
19.09.2013 13:22:19
Добрый день!
Не сохраняется макрос, якобы во 2 строке ошибка - выделяется красным!
27.02.2014 11:37:24
Добрый день.
А как можно сделать появление галочки при двойном щелчке (чтоб исключить нечаянное проставление)?
Написал такой код, логически верно все

'Ставим флажок, если был двойной щелчок по ячейке
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range) 
If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("W2:NW100")) Is Nothing Then
....

но выдает ошибку
Ambiguous name detected: Worksheet_BeforeDoubleClick
Подскажите, пожалуйста, какой код будет корректный для появления и исчезания галочки двойным щелчком.
То же считаю это намного удобнее, для этого вставил такой код:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
        If Target <> "" Then
            Application.EnableEvents = False
            Cancel = True
            Target.ClearContents
            Application.EnableEvents = True
        Else
            Application.EnableEvents = False
            Target.Font.Name = "Marlett"
            Target = "a"
            Application.EnableEvents = True
            Cancel = True
        End If
    End If
End Sub

23.04.2018 10:53:33
прикольно! спасибо!
01.06.2014 17:18:07
А возможно ли сделать так, что бы помеченная строка автоматически переносилась в конец таблицы на другом листе?
02.10.2014 11:20:24
Это уже макрос надо писать.
11.09.2014 13:24:18
Николай, подскажите пожалуйста как создать макрос, который бы давал возможность ставить галочки в двух столбцах (допустим справа и слева общего массива)?
Можно вместо второй галочки другой символ.
Дублируем первый код с заменой адреса столбца?
Я права?
02.10.2014 11:20:02
Абсолютно :)
KIP
02.10.2014 08:30:31
доброго дня, Николай, возможно ли на отдельном листе выводить типа реестр по отмеченым галочкой строчки?
KIP
02.10.2014 13:28:46
Да, спасибо работает, но если список большой то при установке галочек, призадумывается, и каждый реестр будет иметь различное количество строк, поэтому это маленько не то, а вот если сделать кнопку после нажатия на которую все помеченные строки галочкой попадали в реестр, был б изумительно, но вот как должен выглядеть макрос,  поставте на путь истинный, заранее благодарен.
02.02.2015 17:04:29
макрос должен сначала найти последнюю строку, где стоит галочка, например так:
Y=cells(rows.count,1).end(xlUp).row

а потом переписать с этого листа на нужный вам, те строки (от 2 до Y), в которых есть галочка
02.02.2015 17:00:48
Возможно, у тех, у кого много строк и притормаживает может ускориться при замене строки
If Not Intersect(Target, Range("A2:A100"))  Is Nothing Then
на строку
if target.column=1 and target.row>1 then

В таком случае проверяется, если мы жмем в первом столбце, то только тогда ставить галочку.
19.05.2015 19:33:19
Возможно ли сделать, чтобы тип добавляемого символа назначался бы по условию. Например, по выбору из раскрывающегося списка?
25.06.2015 05:32:27
Добрый день, подскажите как можно изменить код чтобы он срабатывал на объединенной ячейке?
18.01.2016 03:30:46
Если этот код вставляю в шаблон(лист которого чист), то при копировании таблицы в шаблон выдает ошибку в строке

If Target.Cells.Count > 1 Then

как этого избежать?, но при вставке в шаблон вариант
Владислав Шевченко08.05.2015 16:31:10 - работает, но Worksheet_BeforeDoubleClick - не удобен.
01.04.2016 13:24:37
я даже текст присобачил галочка и принято )))
22.01.2017 05:34:58
Уважаемый, Николай Павлов!
Огромное спасибо за пример, очень помог в моем проекте:D
10.08.2017 20:25:17
Как эти методы провернуть, но по клику на объединенную ячейку?
Т.к. у меня выдает ошибку run-time error '13' :  type mismatch
18.12.2018 21:53:33
Николай, благодарю за такую удобную разработку. Если вас не затруднит, подскажите как сделать так, чтобы по щелчку левой кнопки мыши в ячейку вводился символ "1", а по щелчку правой кнопкой например "2". Возможно ли такое сделать?
19.12.2018 20:57:23
Ладно вопрос снят, сам разобрался и нахимичил. Вроде бы работает моя задумка и хорошо работает )))
06.02.2019 11:29:24
Немного допилил код с тем, чтобы при повторном щелчке по ячейке галочка исчезала:


If Target.Cells.Count > 1 Then Exit Sub
       If Not Intersect(Target, Range("tSites[Checked]")) Is Nothing Then 'имя таблицы[колонка]
          If Target.Value = "" Then        ' при первом щелчке ставим галочку, если ячейка пустая
               Application.EnableEvents = False
               Target.Font.Name = "Marlett"
               Target = "a"
               Application.EnableEvents = True
               A = Target.Column
           Else                                    ' если ячейка не пустая, то очищаем ея
               Application.EnableEvents = False
               Target.Clear
               Application.EnableEvents = True
           End If
       End If

Однако, если не уходить из ячейки, то второй щелчок её не очищает. Если же сменить ячейку и потом вернуться - то все работает.
Как сделать так,чтобы при первом щелчке - ставилась галочка, при втором - очищалась ?
Наверх