Ввод данных с помощью диалогового окна
Можно настроить программу таким образом, что ввод строго ограниченных данных в указанный диапазон будет осуществляться только с помощью диалогового окна. Для этого нужно воспользоваться макросом, код которого приведен в листинге 2.35.
Листинг 2.35. Настройка ввода данных в диалоговом окне
Sub DialogInputData()
Dim intMin As Integer, intMax As Integer ' Диапазон значений
Dim strInput As String ' Введенная пользователем строка
Dim strMessage As String
Dim intValue As Integer
intMin = 1 ' Минимальное значение
intMax = 50 ' Максимальное значение
strMessage = "Введите значение от " & intMin & " до " & intMax
' Ввод значения (цикл завершается, когда пользователь вводит _
значение из заданного диапазона или отменяет ввод)
Do
strInput = InputBox(strMessage)
If strInput = "" Then Exit Sub ' Отмена ввода
' Проверка, содержит ли введенная пользователем строка число
If IsNumeric(strInput) Then
intValue = CInt(strInput)
' Проверка, удовлетворяет ли значение диапазону
If intValue >= intMin And intValue <= intMax Then
' Все условия выполнены
Exit Do
End If
End If
' Формирование сообщения с текстом ошибки
strMessage = "Вы ввели некорректное значение." & vbNewLine & _
"Введите число от " & intMin & " до " & intMax
Loop
' Внесение данных в ячейку
ActiveSheet.Range("A1").Value = strInput
End Sub
После написания данного кода в окне выбора макросов станет доступен макрос DialoglnputData. Для его вызова лучше создать специальную кнопку. После нажатия данной кнопки откроется диалоговое окно с предложением ввести значение от 1 до 50 (интервал значений можно изменять по своему усмотрению – для этого достаточно внести соответствующие изменения в код макроса). При попытке ввода значения, которое выходит за рамки указанного интервала, появится окно с соответствующим предупреждением и повторным предложением ввести корректное значение. Введенное значение будет помещено в ячейку А1 – это указано в строке кода ActiveSheet.Range ("Al"). Value = strlnput. Если в данной строке вместо А1 указать, например, В1: Е5, то введенное значение будет помещено во все ячейки указанного интервала.
Непосредственный ввод данных
Если ввод данных с использованием диалогового окна по каким-либо причинам нецелесообразен, то можно вводить их непосредственно в диапазон. При этом программа будет контролировать вводимые данные (чтобы они не выходили за рамки указанного интервала).
Выделим на рабочем листе какой-либо диапазон (например, А1:Е10) и назовем его InputRange. Теперь в редакторе VBA в модуле рабочего листа напишем код, представленный в листинге 2.36.
Листинг 2.36. Ограничение возможных значений диапазона
Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rgInputRange As Range
Dim cell As Range
Dim strMessage As String
Dim varResult As Variant
' Диапазон, в котором контролируется ввод
Set rgInputRange = Range("A1:E10")
' Просмотр всех измененных ячеек и контроль ввода в тех,
которые _
принадлежат заданному диапазону
For Each cell In Target
' Проверка принадлежности диапазону
If Union(cell, rgInputRange).Address =
rgInputRange.Address Then
' Контроль правильности ввода
varResult = IsCellDataValid(cell)
If varResult = True Then
' Введено корректное значение
Exit Sub
Else
' Формирование и вывод сообщения об ошибке
strMessage = "Ячейка " & cell.Address(False, False) &
":" _
& vbCrLf & vbCrLf & varResult
MsgBox strMessage, vbCritical, "Неправильное значение"
' Очистка ввода
Application.EnableEvents = False
cell.ClearContents
cell.Activate
Application.EnableEvents = True
End If
End If
Next cell
End Sub
Function IsCellDataValid(cell As Range) As Variant
' Возвращает True, если в ячейку вводится целое число _
в диапазоне от 1 до 12. В противном случае выдается _
соответствующее сообщение
' Проверка, является ли содержимое ячейки числом
If Not WorksheetFunction.IsNumber(cell.Value) Then
IsCellDataValid = "Нечисловое значение"
Exit Function
End If
' Проверка, является ли введенное число целым
If Int(cell.Value) <> cell.Value Then
IsCellDataValid = "Введите целое число"
Exit Function
End If
' Проверка соответствия числа диапазону
If cell.Value < 1 Or cell.Value > 12 Then
IsCellDataValid = "Значение должно быть от 1 до 12"
Exit Function
End If
' В ячейку введено допустимое значение
IsCellDataValid = True
End Function
После написания данного кода в диапазон А1:Е10 можно будет вводить только целые числовые значения, попадающие в интервал от 1 до 12. При попытке ввода нечислового значения (например, текста) программа не позволит этого сделать – на экране отобразится окно с сообщением Нечисловое значение. Ввод дробного числа также будет невозможен – появится сообщение Введите целое число. Если же попытаться ввести значение, выходящее за рамки интервала от 1 до 12, то это также окажется невозможным и будет выдано сообщение Значение должно быть от 1 до 12.
Последовательный ввод данных
Многие пользователи сталкивались с ситуацией, когда необходимо быстро ввести данные и при этом каждый раз приходится вручную устанавливать курсор в нужное место. При вводе большого количества данных это и утомляет, и раздражает. Поэтому трюк, который мы сейчас рассмотрим, в подобных случаях наверняка найдет свое применение.
Смысл операции заключается в том, что необходимые данные будут вводиться в диалоговом окне и лишь после нажатия ОК они займут свое место в таблице. Сразу после этого в диалоговом окне можно будет вводить уже следующие данные и т. д. И все это – независимо от расположения курсора. Реализацию данной возможности рассмотрим на конкретном примере.
Предположим, что в ячейки столбца А необходимо последовательно ввести перечень дат, а в ячейки столбца В – торговую выручку, соответствующую каждой дате столбца А. Решить эту задачу можно с помощью макроса, код которого (он должен быть помещен в стандартный модуль) приведен в листинге 2.37.
Листинг 2.37. Последовательный ввод данных
Sub StreamInput()
Dim strDate As String
Dim strSum As String
Dim lngRow As Long
' Ввод данных в цикле (повторяется до тех пор, пока пользователь _
не введет пустую строку или не нажмет "Отмена" в окне ввода)
Do
lngRow = Range("A65536").End(xlUp).Row + 1
' Ввод даты
strDate = InputBox("Вводим дату")
If strDate = "" Then Exit Sub
' Ввод выручки
strSum = InputBox("Вводим выручку")
If strSum = "" Then Exit Sub
' Запись данных в ячейки
Cells(lngRow, 1) = strDate
Cells(lngRow, 2) = strSum
Loop
End Sub
После написания кода макрос Streamlnput будет доступен в окне выбора макросов. Для удобства поместите в любое удобное место интерфейса кнопку и привяжите к ней данный макрос – и можно приступать к последовательному вводу данных.
Введем в ячейки А1 и В1 названия соответствующих столбцов таблицы (например, Дата и Выручка) и нажмем кнопку вызова макроса. В результате откроется диалоговое окно, в котором с клавиатуры сначала вводится дата (в поле Вводим дату), а после нажатия кнопки ОК – сумма выручки (в поле Вводим выручку). После еще одного нажатия кнопки ОК введенные данные отобразятся в ячейках А2 и В2 соответственно, а в диалоговом окне можно вводить следующие данные (которые, в свою очередь, будут помещены в ячейки A3 и ВЗ) и т. д. Для выхода из цикла следует нажать в диалоговом окне кнопку Cancel
Быстрое выделение ячеек с отрицательными значениями
Рассматриваемый в данном подразделе прием позволяет быстро залить красным цветом ячейки выделенного диапазона, содержащие отрицательные значения. Особую значимость данный трюк приобретает при работе с большими объемами информации.
Напишем в стандартном модуле редактора VBA код, который выглядит следующим образом (листинг 2.38).
Листинг 2.38. Выделение отрицательных значений
Sub NegSelect()
Dim cell As Range
' Просмотр всех ячеек выделенного диапазона и пометка тех, _
которые содержат отрицательные значения
For Each cell In Selection
If cell.Value < 0 Then
cell.Interior.Color = RGB(255, 0, 0)
Else
cell.Interior.ColorIndex = xlNone
End If
Next cell
End Sub
После написания кода в окне выбора макросов станет доступен макрос NegSelect. В результате его выполнения все ячейки выделенного диапазона, содержащие отрицательные значения, будут залиты красным цветом.
Очевидно, что путем внесения соответствующих изменений в код макроса можно изменить как условие, так и цвет выделения.
Получение информации о выделенном диапазоне
При необходимости можно быстро получить подробную информацию о выделенном в данный момент диапазоне – в частности, тип выделения, количество выделенных ячеек и областей и т. д. Для этого в стандартном модуле редактора 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