Получение информации о выделенном диапазоне
При необходимости можно быстро получить подробную информацию о выделенном в данный момент диапазоне – в частности, тип выделения, количество выделенных ячеек и областей и т. д. Для этого в стандартном модуле редактора VBA напишем код, который приведен в листинге 2.39.
Листинг 2.39. Получение информации о выделенном диапазоне
Altribute VB_Name = "module 1"
Sub TypeOfSelection()
Dim rgSelUnion As Range ' Объединение выделенных областей
Dim strTitle As String ' Заголовок сообщения
Dim strMessage As String ' Текст сообщения
Dim strSelType As String ' Тип выделения (простой или _ множественный)
Dim lngBlockCount As Long ' Количество блоков в выделении
Dim lngCellCount As Variant ' Общее количество выделенных ячеек
Dim lngColCount As Long ' Количество выделенных столбцов
Dim lngRowCount As Long ' Количество выделенных строк
Dim lngAreasCount As Long ' Количество выделенных областей
Dim strCurSelType As String
Dim rgArea As Range
' Подсчет количества выделенных областей и определение типа
выделения: _
простое (одна область) или сложное(несколько областей)
intAreasCount = Selection.Areas.Count
If intAreasCount = 1 Then
strTitle = "Простое выделение"
Else
strTitle = "Множественное выделение"
End If
' Определение типа выделения первой области
strSelType = dhGetAreaType(Selection.Areas(1))
' Создание объединения во избежание повторного учета _
пересекающихся участков выделенных диапазонов
Set rgSelUnion = Selection.Areas(1)
For Each rgArea In Selection.Areas
strCurSelType = dhGetAreaType(rgArea)
' Изменение надписи о типе всего выделения, если _
есть выделения различного типа
If strCurSelType <> strSelType Then
strSelType = "Множественный"
End If
' Определение количества блоков перед их добавлением
в объединение
If strCurSelType = "Block" Then
lngBlockCount = intBlockCount + 1
End If
' Добавление в объединение
Set rgSelUnion = Union(rgSelUnion, rgArea)
Next rgArea
' Просматриваются элементы созданного объединения
For Each rgArea In rgSelUnion.Areas
Select Case dhGetAreaType(rgArea)
Case "Строка"
lngRowCount = lngRowCount + rgArea.Rows.Count
Case "Столбец"
lngColCount = lngColCount + rgArea.Columns.Count
Case "Лист"
lngColCount = lngColCount + rgArea.Columns.Count
lngRowCount = lngRowCount + rgArea.Rows.Count
End Select
Next rgArea
' Определение количества неперекрывающихся ячеек
intCellCount = rgSelUnion.Count
' Формирование и вывод итогового сообщения
strMessage = "Тип выделения:" & vbTab & strSelType & vbCrLf & _
"Количество областей: " & vbTab & intAreasCount & vbCrLf
& _
"Полных столбцов: " & vbTab & intColCount & vbCrLf & _
"Полных строк: " & vbTab & intRowCount & vbCrLf & _
"Блоков ячеек: " & vbTab & intBlockCount & vbCrLf & _
"Всего ячеек: " & vbTab & Format(intCellCount,
"#,###")
MsgBox strMessage, vbInformation, strTitle
End Sub
Function dhGetAreaType(rgRangeArea As Range) As String
' Определение типа диапазона
If rgRangeArea.Count = Cells.Count Then
' Все ячейки рабочего листа
dhGetAreaType = "Лист"
ElseIf rgRangeArea.Cells.Count = 1 Then
' Одна ячейка
dhGetAreaType = "Ячейка"
ElseIf rgRangeArea.Rows.Count = Cells.Rows.Count Then
' Весь столбец
dhGetAreaType = "Столбец"
ElseIf rgRangeArea.Columns.Count = Cells.Columns.Count Then
' Вся строка
dhGetAreaType = "Строка"
Else
' Блок ячеек
dhGetAreaType = "Блок"
End If
End Function
После написания данного кода в окне выбора макросов будет доступен макрос TypeOf Selection. Выделив произвольный диапазон (или несколько диапазонов), следует запустить этот макрос на выполнение. В результате откроется окно с указанием типа выделения, количества выделенных областей, полных столбцов и строк, блоков ячеек и общего количества ячеек.
Примечание
Этот макрос (информация о диапазоне) работает только в случае, когда текущая книга сохранена в файле типа Excel 1997–2003.
Кнопка для изменения числового формата ячейки
Как известно, для перехода в режим изменения формата ячейки необходимо или выполнить команду контекстного меню Формат ячеек, или на вкладке Главная в группе Ячейки нажать кнопку Формат и выбрать пункт Формат ячеек, или нажать сочетание клавиш Ctrl+1. Однако для изменения числового формата ячейки можно также воспользоваться специально созданной пользовательской панелью инструментов. Рассмотрим этот процесс подробнее.
Для реализации примера нам потребуется написать в редакторе VBA два кода: в модуле рабочего листа и в стандартном модуле. Код, помещаемый в модуль рабочего листа, выглядит следующим образом (листинг 2.40).
Листинг 2.40. Код в модуле рабочего листа
Sub Worksheet_Change(ByVal Target As Excel.Range)
Call UpdateToolbar
End Sub
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Call UpdateToolbar
End Sub
В стандартном модуле редактора VBA необходимо написать код, который приведен в листинге 2.41.
Листинг 2.41. Код в стандартном модуле
Sub FastChangeNumberFormat()
Dim bar As CommandBar
Dim button As CommandBarButton
' Удаление существующей панели инструментов (если она есть)
On Error Resume Next
CommandBars("Числовой формат").Delete
On Error GoTo 0
' Формирование новой панели
Set bar = CommandBars.Add
With bar
.Name = "Числовой формат"
.Visible = True
End With
' Создание кнопки
Set button = CommandBars("Числовой формат").Controls.Add _
(Type:=msoControlButton)
With button
.Caption = ""
.OnAction = "ChangeNumFormat"
.TooltipText = "Щелкните для изменения числового формата"
.Style = msoButtonCaption
End With
' Обновление созданной панели инструментов
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
' Обновление панели инструментов (если она создана)
On Error Resume Next
' Изменение заголовка кнопки (на название формата выделенной ячейки)
CommandBars("Числовой формат").Controls(1).Caption = _
ActiveCell.NumberFormat
End Sub
Sub ChangeNumFormat()
' Отображение диалогового окна изменения формата ячейки
Application.Dialogs(xlDialogFormatNumber).Show
Call UpdateToolbar
End Sub
Теперь нужно запустить на выполнение макрос FastChangeNumberFormat (после написания кода он будет доступен в окне выбора макросов) – в результате на вкладке Надстройки появится одна кнопка. Название данной кнопки зависит от формата активной ячейки. При подведении к кнопке указателя мыши отобразится всплывающая подсказка Числовой формат: Щелкните для изменения числового формата. При нажатии данной кнопки откроется вкладка Число окна Формат ячеек. Формат активной ячейки изменяется в данном режиме по обычным правилам.
Следует отметить, что перейти в режим редактирования числового формата ячейки можно, запустив на выполнение макрос ChangeNumFormat – после написания приведенного выше кода он также будет доступен в окне выбора макросов.
Тестирование скорости чтения и записи диапазонов
В процессе работы с электронными таблицами часто приходится переносить значения из массива в диапазон или из диапазона в массив. При этом скорость получения данных из диапазона обычно выше скорости записи. С помощью трюка, который мы сейчас рассмотрим, можно тестировать скорость записи данных массива в диапазон и переноса этих данных обратно в массив.
В стандартном модуле редактора VBA нужно написать код, содержимое которого представлено в листинге 2.42.
Листинг 2.42. Тестирование скорости чтения и записи диапазонов
Sub TableSpeedTest()
Dim alngData() As Long ' Массив с числами
Dim lngCount As Long ' Количество элементов в массиве
Dim dtStart As Date ' Хранит время (и даже дату)
начала _ тестирования
Dim strArrayToTable As String ' Время записи в таблицу
Dim strTableToArray As String ' Время чтения из таблицы
Dim strMessage As String
Dim i As Long
' Подготовка диапазона ячеек
Range("A:A").ClearContents
' Ввод размера массива, формирование массива заданного размера
lngCount = InputBox("Введите количество элементов")
ReDim alngData(1 To lngCount)
' Заполнение массива данными
For i = 1 To lngCount
alngData(i) = i
Next i
' Перенос массива в таблицу
Application.ScreenUpdating = False
dtStart = Timer