Следующие простые примеры макросов Excel иллюстрируют некоторые возможности и приёмы, описанные в самоучителе по Excel VBA.
Макрос Excel: пример 1
Первоначально эта процедура Sub была приведена, как пример использования комментариев в коде VBA. Однако, здесь также можно увидеть, как объявляются переменные, как работают ссылки на ячейки Excel, использование цикла For, условного оператора If и вывод на экран окна сообщения.
'Процедура Sub выполняет поиск ячейки, содержащей заданную строку 'в диапазоне ячеек A1:A100 активного листа Sub Find_String(sFindText As String) Dim i As Integer 'Целое число типа Integer, используется в цикле For Dim iRowNumber As Integer 'Целое число типа Integer для хранения результата iRowNumber = 0 'Просматривает одну за другой ячейки A1:A100 до тех пор, пока не будет найдена строка sFindText For i = 1 To 100 If Cells(i, 1).Value = sFindText Then 'Если совпадение с заданной строкой найдено 'сохраняем номер текущей строки и выходим из цикла For iRowNumber = i Exit For End If Next i 'Сообщаем пользователю во всплывающем окне найдена ли искомая строка 'Если заданная строка найдена, указываем в какой ячейке найдено совпадение If iRowNumber = 0 Then MsgBox "Строка " & sFindText & " не найдена" Else MsgBox "Строка " & sFindText & " найдена в ячейке A" & iRowNumber End If End Sub
Макрос Excel: пример 2
Следующая процедура Sub – пример использования цикла Do While. Здесь также можно увидеть, как объявляются переменные, работу со ссылками на ячейки Excel и применение условного оператора If.
'Процедура Sub выводит числа Фибоначчи, не превышающие 1000 Sub Fibonacci() Dim i As Integer 'Счётчик для обозначения позиции элемента в последовательности Dim iFib As Integer 'Хранит текущее значение последовательности Dim iFib_Next As Integer 'Хранит следующее значение последовательности Dim iStep As Integer 'Хранит размер следующего приращения 'Инициализируем переменные i и iFib_Next i = 1 iFib_Next = 0 'Цикл Do While будет выполняться до тех пор, пока значение 'текущего числа Фибоначчи не превысит 1000 Do While iFib_Next < 1000 If i = 1 Then 'Особый случай для первого элемента последовательности iStep = 1 iFib = 0 Else 'Сохраняем размер следующего приращения перед тем, как перезаписать 'текущее значение последовательности iStep = iFib iFib = iFib_Next End If 'Выводим текущее число Фибоначчи в столбце A активного рабочего листа 'в строке с индексом i Cells(i, 1).Value = iFib 'Вычисляем следующее число Фибоначчи и увеличиваем индекс позиции элемента на 1 iFib_Next = iFib + iStep i = i + 1 Loop End Sub
Макрос Excel: пример 3
Эта процедура Sub просматривает ячейки столбца A активного листа до тех пор, пока не встретит пустую ячейку. Значения записываются в массив. Этот простой макрос Excel показывает работу с динамическими массивами, а также использование цикла Do Until. В данном примере мы не будет совершать какие-либо действия с массивом, хотя в реальной практике программирования после того, как данные записаны в массив, над ними такие действия, как правило, совершаются.
'Процедура Sub сохраняет значения ячеек столбца A активного листа в массиве Sub GetCellValues() Dim iRow As Integer 'Хранит номер текущей строки Dim dCellValues() As Double 'Массив для хранения значений ячеек iRow = 1 ReDim dCellValues(1 To 10) 'Цикл Do Until перебирает последовательно ячейки столбца A активного листа 'и извлекает их значения в массив до тех пор, пока не встретится пустая ячейка Do Until IsEmpty(Cells(iRow, 1)) 'Проверяем, что массив dCellValues имеет достаточный размер 'Если нет – увеличиваем размер массива на 10 при помощи ReDim If UBound(dCellValues) < iRow Then ReDim Preserve dCellValues(1 To iRow + 9) End If 'Сохраняем значение текущей ячейки в массиве dCellValues dCellValues(iRow) = Cells(iRow, 1).Value iRow = iRow + 1 Loop End Sub
Макрос Excel: пример 4
В этом примере процедура Sub считывает значения из столбца A рабочего листа Лист2 и выполняет с ними арифметические операции. Результаты заносятся в ячейки столбца A на активном рабочем листе. В этом макросе продемонстрировано использование объектов Excel. В частности, производится обращение процедурой Sub к объекту Columns, и показано, как доступ к этому объекту осуществляется через объект Worksheet. Показано так же, что при обращении к ячейке или диапазону ячеек на активном листе, имя этого листа при записи ссылки указывать не обязательно.
'Процедура Sub при помощи цикла считывает значения в столбце A рабочего листа Лист2, 'выполняет с каждым значением арифметические операции и записывает результат в 'столбец A активного рабочего листа (Лист1) Sub Transfer_ColA() Dim i As Integer Dim Col As Range Dim dVal As Double 'Присваиваем переменной Col столбец A рабочего листа Лист 2 Set Col = Sheets("Лист2").Columns("A") i = 1 'При помощи цикла считываем значения ячеек столбца Col до тех пор, 'пока не встретится пустая ячейка Do Until IsEmpty(Col.Cells(i)) 'Выполняем арифметические операции над значением текущей ячейки dVal = Col.Cells(i).Value * 3 - 1 'Следующая команда записывает полученный результат в столбец A активного рабочего листа 'Имя листа в ссылке указывать нет необходимости, так как это активный лист. Cells(i, 1) = dVal i = i + 1 Loop End Sub
Макрос Excel: пример 5
Данный макрос показывает пример кода VBA, отслеживающего событие Excel. Событие, к которому привязан макрос, происходит каждый раз при выделении ячейки или диапазона ячеек на рабочем листе. В нашем случае при выделении ячейки B1, на экран выводится окно с сообщением.
'Данный код показывает окно с сообщением, если на текущем рабочем листе 'выбрана ячейка B1 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Проверяем выбрана ли ячейка B1 If Target.Count = 1 And Target.Row = 1 And Target.Column = 2 Then 'Если ячейка B1 выбрана, выполняем необходимое действие MsgBox "Вы выбрали ячейку B1" End If End Sub
Макрос Excel: пример 6
На примере этой процедуры показано использование операторов On Error и Resume для обработки ошибок. В данном коде также показан пример открытия и чтения данных из файла.
'Процедура Sub присваивает аргументам Val1 и Val2 значения ячеек A1 и B1 'из рабочей книги Data.xlsx, находящейся в папке C:\Documents and Settings Sub Set_Values(Val1 As Double, Val2 As Double) Dim DataWorkbook As Workbook On Error GoTo ErrorHandling 'Открываем рабочую книгу с данными Set DataWorkbook = Workbooks.Open("C:\Documents and Settings\Data") 'Присваиваем переменным Val1 и Val2 значения из заданной рабочей книги Val1 = Sheets("Лист1").Cells(1, 1) Val2 = Sheets("Лист1").Cells(1, 2) DataWorkbook.Close Exit Sub ErrorHandling: 'Если файл не найден, пользователю будет предложено поместить искомый файл 'в нужную папку и после этого продолжить выполнение макроса MsgBox "Файл Data.xlsx не найден! " & _ "Пожалуйста добавьте рабочую книгу в папку C:\Documents and Settings и нажмите OK" Resume End Sub
Урок подготовлен для Вас командой сайта office-guru.ru
Источник: http://www.excelfunctions.net/Excel-Macro-Example.html
Перевел: Антон Андронов
Правила перепечатки
Еще больше уроков по Microsoft Excel