Ввод данных с помощью диалогового окна
Можно настроить программу таким образом, что ввод строго ограниченных данных в указанный диапазон будет осуществляться только с помощью диалогового окна. Для этого нужно воспользоваться макросом, код которого приведен в листинге 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. В результате его выполнения все ячейки выделенного диапазона, содержащие отрицательные значения, будут залиты красным цветом.
Очевидно, что путем внесения соответствующих изменений в код макроса можно изменить как условие, так и цвет выделения.