Часто бывает надо записать (или вставить найденный в интернете) макрос, но перед его выполнением таблицу надо подготовить. В этой заметке я собрал именно такие фрагменты макросов Excel, которые постоянно повторяю в своих макросах. Можно использовать их как фрагменты кода при написании своих макросов или записать в личную книгу макросов и вызывать при необходимости.
Если Вы не знаете как пользоваться макросами, то сначала можно глянуть мою заметку с приёмами ускоряющими рутинные операции в MS Excel.
1. Выделить до последней строки
Dim lr As Long 'это число строк
lr = Cells(Rows.Count, "A").End(xlUp).Row 'для простоты будем искать конец столбца А
Range("A1:A" & lr).Select
2. Выполнение формулы над столбцом
Допустим надо отрезать первые два символа и один последний в столбце А. Для примера у меня таблица из 5 столбцов (первая строка - заголовок) и будем считать, что в ней нет пустых ячеек (перед этим я убрал пустые ячейки макросом из приёма 5), а число строк я определил методом из приёма 1.
Range("F2").FormulaLocal = "=ПСТР(RC[-5];3;ДЛСТР(RC[-5])-3)" 'для формата ссылок не R1C1 надо просто Formula
Range("F2").AutoFill Destination:=Range("F2:F" & lr)
Range("F2:F" & lr).Copy
Range("A2").Value = Range("F2:F" & lr).Value
Columns("F:F").ClearContents
Формулы могут быть совершенно разными: добавить %, округлить значения, отформатировать телефон после приёма 4 и много другого.
3. Найти значение в таблице и удалить строку
Допустим я хочу сделать рекламную рассылку по списку (столбец А - фамилия, B - телефон), но один человек просил его не беспокоить по такой ерунде. Просто убираем его из списка:
Range("A1").Select 'область, в которой ищем
Set fcell = Cells.Find(What:="Путин", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not fcell Is Nothing Then
fcell.EntireRow.Delete Shift:=xlUp
End If
В общем случае лучше избавляться от Select, Activate и тд. То есть в этом случае вместо ActiveCell лучше писать Range("A1") - код становится менее читабельным, но меньше тормозит при выполнении в цикле.
4. Убрать спецсимволы
Это может быть полезно, чтобы привести список телефонов к одному виду или артикулы для последующего сравнения двух таблиц. Для начала напишем функцию (не в самом макросе, а после него):
Function RepSymb(ByVal sTxt As String)
Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Global = True: objRegExp.IgnoreCase = True
objRegExp.Pattern = "[:\-/?!\*\<\>\|\'$""""]"
RepSymb = objRegExp.Replace(sTxt, "")
End Function
Если захотите добавить ещё символы (например + или ^), то помните, что их надо экранировать символом \ . Регулярные выражения (RegExp) - очень сильный приём в программировании на любом языке программирования, а в сети можно найти уже написанную кем-то регулярку почти на любой случай жизни. Использовать функцию можно например так (записываем в столбец C отформатированное значение столбца D):
Dim lc As Long
For lc = 1 To lr 'lr - это длина таблицы, мы её узнали приёмом 1
Range("D" & lc).Value = RepSymb(Range("C" & lc).Value)
Next lc 'затем можно как в приёме 2 заменить исходные на новые
Как быстро делать подобные операции без макросов я писал в заметке про приёмы, часто используемые в реальной работе.
5. Подготовить лист к работе
Часто приходится применять макросы над таблицами Excel, которые сохранены из 1С (чаще всего это отчёты, сета-фактуры, УПД и накладные). В них зачастую множество ненужных столбцов, некоторые столбцы или строки имеют практически нулевую ширину или высоту, в отчётах ненужные группировки, микроскопические шрифты и другие мешающие обработке.
Selection.ClearOutline
Cells.UnMerge
Cells.ColumnWidth = 20
Cells.RowHeight = 13
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
For rr = LastRow To 1 Step -1
If Application.CountA(Rows(rr)) = 0 Then Rows(rr).Delete
Next rr
LastCol = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
For rc = LastCol To 1 Step -1
If Application.CountA(Columns(rc)) = 0 Then Columns(rc).Delete Shift:=xlToLeft
Next rc
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cells.Replace What:="", Replacement:=" ", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
6. Удалить всё выше и левее выделения
Очень часто надо обрезать ненужные подписи групп слева от таблицы и шапку с заголовком выше таблицы. Фактически это изменение фрагмента макроса из приёма 5.
For rr = ActiveCell.Row - 1 To 1 Step -1
Rows(rr).Delete
Next rr
For rc = ActiveCell.Column - 1 To 1 Step -1
Columns(rc).Delete Shift:=xlToLeft
Next rc
7. Другие полезные функции в одну строку
Вызвать другой макрос, например приём 5.
Application.Run "PERSONAL.XLSB!Макрос5"
Сохранить копию перед выполнением макроса (так как действия макроса нельзя отменить). Но надо помнить, что дальше работа идёт в этой копии, так что если у Вас схема работы не как у меня (открыл из почты файл, обработал макросом, сохранил), то надо немного переделать под себя. Заодно пример как использовать переменные окружения в VBA.
ChDir Environ$("USERPROFILE")
ActiveWorkbook.SaveAs Filename:="Desktop\Таблица.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Показать сообщение.
MsgBox "Привет"
Не показывать процесс выполнения и пропускать ошибки. Рекомендую использовать перед циклами.
Application.ScreenUpdating = False
On Error Resume Next
