Пометка элементов списка
Постановка задачи
Имеем на листе список чего-либо. Хотелось бы использовать привычные флажки-чекбоксы или жирные точки-переключатели для отмечания выбранных элементов. Примерно так:
Решение
Щелкните правой кнопкой мыши по ярлычку листа, где находится список, и выберите в контекстном меню Исходный текст (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") в первом столбце нашей таблицы и, найдя, выдавать фамилию из второго:
Ссылки по теме
Range("A2:A10,A12:A100") - ячейка А11 исключается
Например:
если в ячейках столбце К есть данные, то в этих строках столбца L галки запрещены
Николай, а как возможно автоматически сортировать таблицу по столбцу с флажком, так чтобы они оказывались в конце списка? Просто пустые ячейки не сортируются, возможно туда стоит вставлять бесцветный символ? Буду признаетелен, если подскажите как это возможно сделать!
Пользуюсь данным кодом, все отлично, но появилась необходимость в некоторых дополнениях.
Подскажите пожалуйста, какое максимальное количество диапазонов можно применить в данном коде и есть ли такая возможность сделать так, чтобы в некоторых диапазонах можно было ставить только один флажок?
Можно ли сделать так, чтобы при внесении "крыжиков", в этой же строке, в "энной" ячейке, автоматически проставлялась дата (день, месяц, год) внесения "крыжика".
Подскажите, как сделать такой "крыжик" блокировкий?
Я имею ввиду если он ставится то все ячейки строки слева от него блокируются паролем и крыжик снять можно так же только с паролем.
Не сохраняется макрос, якобы во 2 строке ошибка - выделяется красным!
А как можно сделать появление галочки при двойном щелчке (чтоб исключить нечаянное проставление)?
Написал такой код, логически верно все
'Ставим флажок, если был двойной щелчок по ячейке 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 ....но выдает ошибку
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Можно вместо второй галочки другой символ.
Дублируем первый код с заменой адреса столбца?
Я права?
Y=cells(rows.count,1).end(xlUp).row
а потом переписать с этого листа на нужный вам, те строки (от 2 до Y), в которых есть галочка
If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
на строку
if target.column=1 and target.row>1 then
В таком случае проверяется, если мы жмем в первом столбце, то только тогда ставить галочку.
If Target.Cells.Count > 1 Then
как этого избежать?, но при вставке в шаблон вариант
08.05.2015 16:31:10 - работает, но Worksheet_BeforeDoubleClick - не удобен.
Огромное спасибо за пример, очень помог в моем проекте:D
Т.к. у меня выдает ошибку run-time error '13' : type mismatch
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
Однако, если не уходить из ячейки, то второй щелчок её не очищает. Если же сменить ячейку и потом вернуться - то все работает.
Как сделать так,чтобы при первом щелчке - ставилась галочка, при втором - очищалась ?