Трюк №87. Как при помощи макросов помечать и сбрасывать пометку ячеек при выделении

Иногда бывает трудно делать выбор при помощи флажков. К счастью, этот процесс можно упростить, написав немного кода.

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

Вместо этого можно написать немного очень простого кода VBA, чтобы помечать любую ячейку в указанном диапазоне одновременно с ее выделением. Если ячейка в указанном диапазоне уже помечена, код снимет пометку. Трюк этого кода заключается в использовании буквы «а» в ячейке, для которой установлен шрифт Marlett. Когда настанет время суммировать результаты, нужно будет просто подсчитать буквы «а» при помощи функции СЧЁТЕСЛИ (COUNTIF), например, так: =COUNITIF($A$1:A$100;"a"), в русской версии Excel: =СЧЁТЕСЛИ($А$1:А$100;"а").

Следующие примеры кода работают только в диапазоне А1:А100, но их можно легко модифицировать для любого диапазона. Чтобы использовать этот код, перейдите на рабочий лист, на котором должны появиться пометки, правой кнопкой мыши щелкните ярлычок с именем листа и в контекстном меню выберите команду Исходный текст (View Code). Вставьте либо КОД 1 (если хотите, чтобы ячейка помечалась в момент, когда ее выделяют), либо КОД 2 (если хотите, чтобы ячейка помечалась двойным щелчком), приведенный в листинге 7.12.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

// Листинг 7.12
//КОД 1 - установить флажок одновременно с выделением
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
	If Target.Cells.Count > 1 Then Exit Sub
		If Not Intersect(Target, Range("Al:A100")) Is Nothing Then
			Target.Font.Name = "Marlett"
			If Target = vbNullString Then
				Target = "a"
			Else
				Target = vbNullString
			End If
		End If
End Sub
 
//КОД 2 - установить флажок двойным щелчком
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range. Cancel As Boolean)
	If Not IntersectCTarget, Range("Al:A100")) Is Nothing Then
		Cancel = True //Предотвращает переход в режим редактирования
			Target.Font.Name = "Marlett"
			If Target = vbNullString Then
				Target = "a"
			Else
				Target = vbNullString
		End If
	End If
End Sub

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