Текст книги "Excel. Трюки и эффекты"

Автоматизация удаления файлов

Используя средства VBA, можно удалять как отдельные файлы, так и группы файлов в соответствии с заданными параметрами.

Чтобы удалить отдельный файл, можно воспользоваться следующим макросом (листинг 3.49).

Листинг 3.49. Удаление файла

Sub DeleteFile()

Kill «C:Документыprimer.xls»

End Sub

В результате выполнения данного макроса будет удален файл primer.xls, расположенный по адресу С: Документы.

Для удаления группы файлов с определенным расширением можно использовать следующий макрос (листинг 3.50).

Листинг 3.50. Удаление группы файлов

Sub DeleteFiles()

' Удаление всех файлов с расширением XLS из заданной папки

Kill «C:Документы» & «*.xls»

End Sub

После выполнения этого макроса из папки Документы на диске С: будут удалены все файлы, имеющие расширение XLS.

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

Перечень имен листов в виде гиперссылок

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

Листинг 3.51. Перечень имен рабочих листов

Sub SheetNamesAsHyperLinks()

Dim sheet As Worksheet

Dim cell As Range

With ActiveWorkbook

' Просмотр всех листов книги и создание гиперссылок на них _

на первом листе

For Each sheet In ActiveWorkbook.Worksheets

Set cell = Worksheets(1).Cells(sheet.Index, 1)

.Worksheets(1).Hyperlinks.Add Anchor:=cell, Address:="", _

SubAddress:="’" & sheet.Name & "“" & «!A1»

cell.Formula = sheet.Name

Next

End With

End Sub

Результат выполнения макроса показан на рис. 3.15 – имена рабочих листов выведены в виде списка, каждый элемент которого представляет собой гиперссылку.

Рис. 3.15. Список имен рабочих листов

Удаление пустых строк на рабочем листе

В процессе работы иногда возникает необходимость избавиться от пустых строк на рабочем листе. В большинстве случаев для решения данной задачи используются штатные средства программы. Однако при большом количестве пустых строк целесообразно воспользоваться макросом, код которого приведен в листинге 3.52.

Листинг 3.52. Удаление пустых строк (вариант 1)

Sub DeleteEmptyStrings()

Dim intLastRow As Integer ' Номер последней используемой

строки

Dim intRow As Integer ' Номер проверяемой строки

' Получение номера последней используемой строки

intLastRow = Worksheets(ActiveSheet.Index).UsedRange.Row + _

Worksheets(ActiveSheet.Index).UsedRange.Rows.Count – 1

' Счетчик устанавливается на используемую первую строку

intRow = Worksheets(ActiveSheet.Index).UsedRange.Row

' Удаление пустых строк

Do While intRow <= intLastRow

If ActiveSheet.Rows(intRow).Text = "" Then

' Удаление строки

ActiveSheet.Rows(intRow).Delete

' Данные сдвинулись вверх, поэтому номер последней _

строки уменьшился, а текущей – не изменился

intLastRow = intLastRow – 1

Else

' Текущая строка заполнена – переходим к следующей

intRow = intRow + 1

End If

Loop

End Sub

При выполнении данной операции следует учитывать, что будут удалены только пустые строки, представляющие собой «пробелы». Например, если данные хранятся в строках с 1 по 10, но при этом строки 5 и 7 пустые, то после применения макроса строки 5 и 7 будут удалены и заменены следующими за ними строками с данными, а строки 11,12,13,14…. останутся на месте.

К аналогичному результату приведет также использование такого макроса (листинг 3.53). В данном случае удаление пустых строк происходит снизу вверх. Это позволяет упростить алгоритм, так как не нужно учитывать сдвиг данных вверх при удалении строк.

Листинг 3.53. Удаление пустых строк (вариант 2)

Sub DeleteEmptyStrings1()

Dim intRow As Integer

Dim intLastRow As Integer

' Получение номера последней используемой строки

intLastRow = ActiveSheet.UsedRange.Row + _

ActiveSheet.UsedRange.Rows.Count – 1

' Удаление пустых строк

For intRow = intLastRow To 1 Step -1

If ActiveSheet.Rows(intRow).Text = "" Then

ActiveSheet.Rows(intRow).Delete

End If

Next intRow

End Sub

Для удобства работы можно создать кнопку и привязать к ней какой-либо из приведенных макросов – тогда удаление пустых строк будет производиться при нажатии этой кнопки.

Запись текущих данных в текстовый файл

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

Листинг 3.54. Запись в текстовый файл

Sub SaveAsText()

Dim cell As Range

' Открытие файла для сохранения (имя файла соответствует

имени _

рабочей книги, но отличается расширением – TXT)

Open ThisWorkbook.Path & "" & ThisWorkbook.Name & «.txt» _

For Output As #1

' Запись содержимого заполненных ячеек таблицы в файл

For Each cell In ActiveSheet.UsedRange

If Not IsEmpty(cell) Then

Print #1, cell.Address, cell.Formula

End If

Next

' Не забываем закрывать файл

Close #1

End Sub

К аналогичному результату приведет использование такого макроса (он отличается тем, что учитывает национальные настройки) (листинг 3.55).

Листинг 3.55. Экспорт в текстовый файл

Sub SaveAsText1()

Dim cell As Range

' Открытие файла для сохранения (имя файла соответствует

имени _

рабочей книги, но отличается расширением – TXT)

Open ThisWorkbook.Path & "" & ThisWorkbook.Name & «.txt» _

For Output As #1

' Запись содержимого заполненных ячеек таблицы в файл

For Each cell In ActiveSheet.UsedRange

If Not IsEmpty(cell) Then

Print #1, cell.Address, cell.FormulaLocal

End If

Next

' Не забываем закрывать файл

Close #1

End Sub

В результате выполнения любого из указанных макросов будет создан текстовый файл, помещенный в тот же каталог, в котором находится текущая рабочая книга. Имя файла формируется следующим образом: если текущий файл называется Primer.xls, то имя созданного на его основе текстового файла будет Primer.xls.txt. В этом файле, помимо хранящихся на рабочем листе данных, содержатся координаты ячеек, в которых расположены эти данные.

Экспорт и импорт данных

В данном разделе мы рассмотрим еще один способ экспортирования данных в текстовый файл, а также импорт данных из текстового файла.

Для решения поставленных задач нам потребуются два макроса: один – для экспорта данных, другой – для их импорта. Чтобы создать эти макросы, напишем в стандартном модуле редактора VBA код, который представлен в листинге 3.56.

Листинг 3.56. Экспорт и импорт данных

Sub ExportAsText()

Dim lngRow As Long

Dim intCol As Integer

' Открытие файла для сохранения

Open «C:primer.txt» For Output As #1

' Запись выделенной части таблицы в файл (построчно)

For lngRow = 1 To Selection.Rows.Count

' Запись содержимого всех столбцов строки lngRow

For intCol = 1 To Selection.Columns.Count

Write #1, Selection.Cells(lngRow, intCol).Value;

Next intCol

' Начнем новую строку в файле

Print #1, ""

Next lngRow

' Не забываем закрыть файл

Close #1

End Sub

Sub ImportText()

Dim strLine As String ' Одна строка файла

Dim strCurChar As String * 1 ' Анализируемый символ строки

файла

Dim strValue As String ' Значение для записи в ячейку

Dim lngRow As Long ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

Dim i As Integer

' Открытие импортируемого файла

Open «C:primer.txt» For Input As #1

' Считываем все строки файла и записываем данные, разделенные _

запятой, в ячейки таблицы (начиная с текущей ячейки)

Do Until EOF(1)

' Считываем строку из файла

Line Input #1, strLine

' Разбираем считанную строку

For i = 1 To Len(strLine)

strCurChar = Mid(strLine, i, 1)

If strCurChar = "," Then

' Найден разделитель столбцов – запятая. Запишем _

сформированное значение в ячейку

ActiveCell.Offset(lngRow, intCol) = strValue

intCol = intCol + 1

strValue = ""

ElseIf i = Len(strLine) Then

' Конец строки – запишем в таблицу последнее _

значение в строке (перед этим дополним его последним _

символом строки, кроме кавычки)

If strCurChar <> Chr(34) Then

strValue = strValue & strCurChar

End If

' Запись в таблицу

ActiveCell.Offset(lngRow, intCol) = strValue

strValue = ""

ElseIf strCurChar <> Chr(34) Then

' Добавление символа в формируемое значение ячейки _

(кавычки игнорируются)

strValue = strValue & strCurChar

End If

Next i

' Переход к новой строке таблицы

intCol = 0

lngRow = lngRow + 1

Loop

' Закрываем файл

Close #1

End Sub

После того как данный код написан, в окне выбора макросов появятся макросы ExportAsText и ImportText. В соответствии в кодом макроса экспорт данных будет осуществляться в файл primer.txt, который будет создан на диске С:. Из этого же файла будут импортированы данные при выполнении макроса ImportText.

Перед запуском макроса ExportAsText необходимо выделить диапазон, данные которого следует экспортировать в текстовый файл. Импортируемые данные будут помещены в то место рабочего листа, в котором установлен курсор (при этом ячейка с курсором будет являться левой верхней ячейкой импортированного диапазона).

В текстовом файле столбцы обозначаются символом, (запятая).

Одновременное умножение всех данных диапазона

В данном разделе мы рассмотрим трюк, с помощью которого можно быстро умножить все числа, находящиеся в какой-либо выделенной области, на указанный коэффициент. Для этого нам понадобится макрос, код которого приведен в листинге 3.57.

Листинг 3.57. Умножение данных

Sub MultAllCells()

Dim dblMult As Double

Dim cell As Range

' Ввод коэффициента для умножения

dblMult = InputBox("Введите коэффициент, на который следует

умножать")

' Умножение содержимого на введенный коэффициент

For Each cell In Selection

If IsNumeric(cell.Value) And cell.Value <> "" Then

' Умножаются только ячейки, содержащие числовые данные

cell.Value = cell.Value * dblMult

Else

MsgBox "В ячейке " & cell.Address & « нечисловое значение»

End If

Next

End Sub

Рассмотрим применение данного макроса на конкретном примере.

Допустим, в ячейках Al, В2 и C3 хранятся числовые значения 10, 15 и 20 соответственно. Выделим диапазон, охватывающий эти ячейки, и запустим приведенный выше макрос на выполнение. В результате откроется окно, изображенное на рис. 3.16.

Рис. 3.16. Окно ввода коэффициента

В данном окне с клавиатуры следует ввести коэффициент, на который необходимо умножить все значения выделенной области. Если ввести коэффициент 2, то в ячейках А1, В2 и C3 значения изменятся соответственно на 20, 30 и40.

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

Преобразование таблицы Excel в HTML-формат

В процессе работы иногда возникает необходимость в быстром преобразовании табличных данных Excel в HTML-код (например, для оперативного размещения на сайте самой свежей информации). Рассмотрим на конкретном примере, каким образом можно решить эту задачу.

Предположим, что нам необходимо преобразовать в HTML-код следующую таблицу (рис. 3.17).

Рис. 3.17. Таблица Excel

В данном случае следует воспользоваться макросом, код которого приведен в листинге 3.58.

Листинг 3.58. Преобразование таблицы в HTML-формат

Sub ExportAsHtml()

Dim strStyle As String ' Параметры стиля отображения

ячейки

Dim strAlign As String ' Параметры выравнивания ячейки

Dim strOut As String ' Выходная строка с HTML-кодом

Dim cell As Object ' Обрабатываемая ячейка

Dim strCellText As String ' Текст обрабатываемой ячейки

Dim lngRow As Long ' Номер строки обрабатываемой

ячейки

Dim lngLastRow As Long ' Номер строки предыдущей ячейки

Dim strTemp As String

Dim objWordApp As Object

Dim i As Long

lngLastRow = Selection.Row

' Просмотр всех выделенных ячеек

For Each cell In Selection

' Значение строки для рассматриваемой ячейки

lngRow = cell.Row

' Если перешли на другую строку, то вставляем <tr>

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & «</tr>» & vbCrLf & vbTab & _

«<tr>» & vbCrLf

' Переход на следующую строку

lngLastRow = lngRow

End If

' Задание шрифта ячейки

If Not IsNull(cell.Font.Size) Then

strStyle = « style=» & "font-size: " & Int(100 * _

cell.Font.Size / 19) & «%;»

End If

' Для полужирного шрифта вставляем <b>

If cell.Font.Bold Then

strCellText = «<b>» & strCellText & «</b>»

End If

' Задание выравнивания

If cell.HorizontalAlignment = xlRight Then

' По правому краю

strAlign = « align=» & «right»

ElseIf cell.HorizontalAlignment = xlCenter Then

' По центру

strAlign = « align=» & «center»

Else

' По левому краю (по умолчанию)

strAlign = ""

End If

' Чтение текста в ячейке

strCellText = cell.Text

' Если нужно, то вертикальный вывод текста (в строку strTemp _

с последующим перенесением обратно в strCellText)

If cell.Orientation <> xlHorizontal Then

strTemp = ""

' Печать после каждого символа специального _

разделителя – <br>

For i = 1 To Len(strCellText)

strTemp = strTemp & Mid$(strCellText, i, 1) & «<br>»

Next i

strCellText = strTemp

strStyle = ""

End If

strOut = strOut & vbTab & vbTab & «<td» & strStyle &

strAlign _

& «>» & strCellText & «</td>» & vbCrLf

Next

' Вставка <tr> для первой строки и </tr> – для последней

strOut = vbTab & "<tr>м & vbCrLf & strOut & vbTab & "</tr>м

& vbCrLf

' Вставка дескриптора <table>

strOut = «<table border=1 cellpadding=3 cellspacing=1>» &

vbCrLf & _

strOut & vbCrLf & «</table>»

' Запускаем Word и показываем в нем сформированный HTML-код

Set objWordApp = CreateObject(«Word.Application»)

objWordApp.documents.Add

objWordApp.Selection = strOut

objWordApp.Selection.Copy

objWordApp.Visible = True

Set objWordApp = Nothing

End Sub

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

В результате применения макроса табличные данные, показанные на рис. 3.17, будут преобразованы в следующий HTML-код:

<table border=1 cellpadding=3 cellspacing=1>

<tr>

<td style=font-size: 52%;>77</td>

<td style=font-size: 52%;>345</td>

</tr>

<tr>

<td style=font-size: 52%; align=right>25</td>

<td style=font-size: 52%;>851</td>

</tr>

<tr>

<td style=font-size: 52%;>44</td>

<td style=font-size: 52%;>415</td>

</tr>

<tr>

<td style=font-size: 52%;>17</td>

<td style=font-size: 52%;>25</td>

</tr>

</table>

Читатель, хотя бы немного знакомый с веб-разработками, без труда узнает знакомый стиль HTML-файла. Этот код будет открыт в отдельном окне Microsoft Word, а также скопирован в буфер обмена.

Преобразовать выделенный диапазон в HTML-формат можно и другим способом. Его отличие от приведенного выше заключается в том, что результатом преобразования будет готовый НТМ-файл, сохраненный по указанному пути. Для реализации данного примера нужно воспользоваться макросом, код которого представлен в листинге 3.59.

Листинг 3.59. Экспорт данных в НТМ-файл

Sub ExportAsHtmlFile()

Dim strStyle As String ' Параметры стиля отображения

ячейки

Dim strAlign As String ' Параметры выравнивания ячейки

Dim strOut As String ' Выходная строка с HTML-кодом

Dim cell As Object ' Обрабатываемая ячейка

Dim strCellText As String ' Текст обрабатываемой ячейки

Dim lngRow As Long ' Номер строки обрабатываемой

ячейки

Dim lngLastRow As Long ' Номер строки предыдущей ячейки

Dim strTemp As String

Dim strFileName As String ' Имя файла для сохранения HTML-

кода

Dim i As Long

' Запрос у пользователя имени файла для сохранения

strFileName = Application.GetSaveAsFilename( _

InitialFileName:="Primer.htm", _

fileFilter:="HTML Files(*.htm), *.htm")

' Проверка, задал ли пользователь имя файла (если нет, _

то можно выходить)

If strFileName = "" Then Exit Sub

lngLastRow = Selection.Row

' Просмотр всех выделенных ячеек

For Each cell In Selection

' Значение строки для рассматриваемое ячейки

lngRow = cell.Row

' Если перешли на другую строку, то вставляем <tr>

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & «</tr>» & vbCrLf & vbTab & _

«<tr>» & vbCrLf

' Переход на следующую сроку

lngLastRow = lngRow

End If

' Задание шрифта ячейки

If Not IsNull(cell.Font.Size) Then

strStyle = « style=» & "font-size: " & Int(100 * _

cell.Font.Size / 19) & «%;»

End If

' Для полужирного шрифта вставляем <b>

If cell.Font.Bold Then

strCellText = «<b>» & strCellText & «</b>»

End If

' Задание выравнивания

If cell.HorizontalAlignment = xlRight Then

' По правому краю

strAlign = « align=» & «right»

ElseIf cell.HorizontalAlignment = xlCenter Then

' По центру

strAlign = « align=» & «center»

Else

' По левому краю (по умолчанию)

strAlign = ""

End If

' Чтение текста в ячейке

strCellText = cell.Text

' Если нужно, то вертикальный вывод текста (в строку strTemp _

с последующим перенесением обратно в strCellText)

If cell.Orientation <> xlHorizontal Then

strTemp = ""

' Печать после каждого символа специального _

разделителя – <br>

For i = 1 To Len(strCellText)

strTemp = strTemp & Mid$(strCellText, i, 1) & «<br>»

Next i

strCellText = strTemp

strStyle = ""

End If

strOut = strOut & vbTab & vbTab & «<td» & strStyle & _

strAlign & «>» & strCellText & «</td>» & vbCrLf

Next

' Вставка <tr> для первой строки и </tr> – для последней

strOut = vbTab & «<tr>» & vbCrLf & strOut & vbTab & «</tr>»

& vbCrLf

' Вставка дескриптора <table>

strOut = «<table border=1 cellpadding=3 cellspacing=1>» _

& vbCrLf & strOut & vbCrLf & «</table>»–

' Сохранение HTML-кода в файл

Open strFileName For Output As 1

Print #1, strOut

Close 1

' Вывод окна с информационным сообщением о результатах работы

MsgBox Selection.Count & " ячеек экспортировано в файл " & _

strFileName

End Sub

После написания кода будет создан макрос ExportAsHtmlFile, результатом работы которого будет сформированный файл Primer.htm (не стоит забывать, что перед выполнением макроса необходимо выделить диапазон, данные которого должны быть преобразованы в HTML-формат). Путь для сохранения по обычным правилам Windows указывается в окне, которое открывается на экране сразу после запуска макроса (в этом же окне можно изменить имя создаваемого файла, которое предлагается по умолчанию). По окончании преобразования на экране отобразится окно, в котором пользователю сообщается количество преобразованных ячеек и путь к созданному НТМ-файлу.

Поиск данных нештатными средствами

Как известно, Excel включает в себя штатные средства поиска требуемых данных. Однако в некоторых случаях для этого целесообразнее использовать макрос, код которого приведен в листинге 3.60.

Листинг 3.60. Поиск данных с помощью макроса

Sub CustomSearch()

Dim strFindData As String

Dim rgFound As Range

Dim i As Integer

' Ввод строки для поиска

strFindData = InputBox(«Введите данные для поиска»)

' Просмотр всех рабочих листов книги

For i = 1 To Worksheets.Count

With Worksheets(i).Cells

' Поиск на i-м листе

Set rgFound = .Find(strFindData, LookIn:=xlValues)

If Not rgFound Is Nothing Then

' Ячейка с заданным значением найдена – выделим ее

Sheets(i).Select

rgFound.Select

Exit Sub

End If

End With

Next

' Поиск завершен. Ячейка не найдена

MsgBox («Поиск не дал результатов»)

End Sub

При выполнении данного макроса открывается окно, изображенное на рис. 3.18.

Рис. 3.18. Ввод данных для поиска

В данном окне с клавиатуры следует ввести текст (число, дату и т. п.), который требуется найти, и нажать кнопку ОК. Результатом поиска будет позиционирование курсора в ячейке с искомым текстом. Если же поиск не дал результатов, то на экран будет выведено окно, изображенное на рис. 3.19.

Рис. 3.19. Информационное сообщение

Следует отметить, что поиск данных ведется не только на текущем рабочем листе, но и на всех остальных листах открытой рабочей книги.

Включение автофильтра с помощью макроса

Как известно, включение автофильтра для выделенного диапазона осуществляется на вкладке Данные с помощью кнопки Фильтр. Для этого можно также воспользоваться следующим макросом (листинг 3.61).

Листинг 3.61. Включение автофильтра

Sub EnableAutoFilter()

On Error Resume Next

Selection.AutoFilter

End Sub

Для данного макроса можно создать значок и поместить его на панель инструментов – это позволит включать автофильтр быстрее, чем стандартным способом.

Трюки с форматированием

В данном разделе мы рассмотрим несколько трюков, с помощью которых можно быстро выполнить нестандартное форматирование выделенного диапазона.

С помощью небольшого макроса можно быстро установить выделенному диапазону ячеек формат «два знака после запятой». Данный макрос выглядит следующим образом (листинг 3.62).

Листинг 3.62. Формат «два знака после запятой»

Sub ChangeNumberFormat()

Selection.NumberFormat = «0.00»

End Sub

После выполнения макроса числа в выделенном диапазоне будут отображены с двумя знаками после запятой (например, число 54 будет показано как 54,0 0).

Для форматирования ячеек с использованием разделителя по разрядам можно применить такой макрос (листинг 3.63).

Листинг 3.63. Использование разделителя по разрядам

Sub ThreeNullSepatator()

Selection.NumberFormat = «#,##»

End Sub

В результате выполнения данного макроса число, например, 1234 5 67 будет представлено в виде 1 234 567. Не стоит забывать, что перед запуском макроса необходимо выделить диапазон, который должен быть отформатирован.

Чтобы отформатировать какой-либо диапазон с использованием разделителя по разрядам и отображением двух знаков после запятой, можно воспользоваться следующим макросом (листинг 3.64).

Листинг 3.64. Изменение формата

Sub ChangeNumerFormatEx()

Selection.NumberFormat = «#,##0.00»

End Sub

В данном случае перед запуском макроса также необходимо выделить требуемый диапазон.