Visual basic изменить excel

Всё о работе с ячейками в Excel-VBA: обращение, перебор, удаление, вставка, скрытие, смена имени.

Содержание:

Table of Contents:

• Что такое ячейка Excel?
• Способы обращения к ячейкам
  • Выбор и активация
  • Получение и изменение значений ячеек
    • Ячейки открытой книги
    • Ячейки закрытой книги 
  • Перебор ячеек
  • Перебор в произвольном диапазоне
• Свойства и методы ячеек
  • Имя ячейки
  • Адрес ячейки
  • Размеры ячейки
• Запуск макроса активацией ячейки

2 нюанса:

1. Я почти везде стараюсь использовать ThisWorkbook (а не, например, ActiveWorkbook) для обращения к текущей книге, в которой написан этот код (считаю это наиболее безопасным для новичков способом обращения к книгам, чтобы случайно не внести изменения в другие книги). Для экспериментов можете вставлять этот код в модули, коды книги, либо листа, и он будет работать только в пределах этой книги. 
2. Я использую английский эксель и у меня по стандарту листы называются Sheet1, Sheet2 и т.д. Если вы работаете в русском экселе, то замените Thisworkbook.Sheets(«Sheet1») на Thisworkbook.Sheets(«Лист1»). Если этого не сделать, то вы получите ошибку в связи с тем, что пытаетесь обратиться к несуществующему объекту. Можно также заменить на Thisworkbook.Sheets(1), но это менее безопасно.

Что такое ячейка Excel?

В большинстве мест пишут: «элемент, образованный пересечением столбца и строки». Это определение полезно для людей, которые не знакомы с понятием «таблица». Для того, чтобы понять чем на самом деле является ячейка Excel, необходимо заглянуть в объектную модель Excel. При этом определения объектов «ряд», «столбец» и «ячейка» будут отличаться в зависимости от того, как мы работаем с файлом.

Объекты в Excel-VBA. Пока мы работаем в Excel без углубления в VBA определение ячейки как «пересечения» строк и столбцов нам вполне хватает, но если мы решаем как-то автоматизировать процесс в VBA, то о нём лучше забыть и просто воспринимать лист как «мешок» ячеек, с каждой из которых VBA позволяет работать как минимум тремя способами:

1. по цифровым координатам (ряд, столбец),
2. по адресам формата А1, B2 и т.д. (сценарий целесообразности данного способа обращения в VBA мне сложно представить)
3. по уникальному имени (во втором и третьем вариантах мы будем иметь дело не совсем с ячейкой, а с объектом VBA range, который может состоять из одной или нескольких ячеек). Функции и методы объектов Cells и Range отличаются. Новичкам я бы порекомендовал работать с ячейками VBA только с помощью Cells и по их цифровым координатам и использовать Range только по необходимости.

Все три способа обращения описаны далее

Как это хранится на диске и как с этим работать вне Excel? С точки зрения хранения и обработки вне Excel и VBA. Сделать это можно, например, сменив расширение файла с .xls(x) на .zip и открыв этот архив.

Пример содержимого файла Excel:

Далее xl -> worksheets и мы видим файл листа

Содержимое файла:

 То же, но более наглядно:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<worksheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac xr xr2 xr3" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac" xmlns:xr="http://schemas.microsoft.com/office/spreadsheetml/2014/revision" xmlns:xr2="http://schemas.microsoft.com/office/spreadsheetml/2015/revision2" xmlns:xr3="http://schemas.microsoft.com/office/spreadsheetml/2016/revision3" xr:uid="{00000000-0001-0000-0000-000000000000}">
	<dimension ref="B2:F6"/>
	<sheetViews>
		<sheetView tabSelected="1" workbookViewId="0">
			<selection activeCell="D12" sqref="D12"/>
		</sheetView>
	</sheetViews>
	<sheetFormatPr defaultRowHeight="14.4" x14ac:dyDescent="0.3"/>
	<sheetData>
		<row r="2" spans="2:6" x14ac:dyDescent="0.3">
			<c r="B2" t="s">
				<v>0</v>
			</c>
		</row>
		<row r="3" spans="2:6" x14ac:dyDescent="0.3">
			<c r="C3" t="s">
				<v>1</v>
			</c>
		</row>
		<row r="4" spans="2:6" x14ac:dyDescent="0.3">
			<c r="D4" t="s">
				<v>2</v>
			</c>
		</row>
		<row r="5" spans="2:6" x14ac:dyDescent="0.3">
			<c r="E5" t="s">
				<v>0</v></c>
		</row>
		<row r="6" spans="2:6" x14ac:dyDescent="0.3">
			<c r="F6" t="s"><v>3</v>
		</c></row>
	</sheetData>
	<pageMargins left="0.7" right="0.7" top="0.75" bottom="0.75" header="0.3" footer="0.3"/>
</worksheet>

Как мы видим, в структуре объектной модели нет никаких «пересечений». Строго говоря рабочая книга — это архив структурированных данных в формате XML. При этом в каждую «строку» входит «столбец», и в нём в свою очередь прописан номер значения данного столбца, по которому оно подтягивается из другого XML файла при открытии книги для экономии места за счёт отсутствия повторяющихся значений. Почему это важно. Если мы захотим написать какой-то обработчик таких файлов, который будет напрямую редактировать данные в этих XML, то ориентироваться надо на такую модель и структуру данных. И правильное определение будет примерно таким: ячейка — это объект внутри столбца, который в свою очередь находится внутри строки в файле xml, в котором хранятся данные о содержимом листа.

Способы обращения к ячейкам

Выбор и активация

Почти во всех случаях можно и стоит избегать использования методов Select и Activate. На это есть две причины:

1. Это лишь имитация действий пользователя, которая замедляет выполнение программы. Работать с объектами книги можно напрямую без использования методов Select и Activate.
2. Это усложняет код и может приводить к неожиданным последствиям. Каждый раз перед использованием Select необходимо помнить, какие ещё объекты были выбраны до этого и не забывать при необходимости снимать выбор. Либо, например, в случае использования метода Select в самом начале программы может быть выбрано два листа вместо одного потому что пользователь запустил программу, выбрав другой лист.

Можно выбирать и активировать книги, листы, ячейки, фигуры, диаграммы, срезы, таблицы и т.д.

Отменить выбор  ячеек можно методом Unselect:

Selection.Unselect

Отличие выбора от активации — активировать можно только один объект из раннее выбранных. Выбрать можно несколько объектов.

Если вы записали и редактируете код макроса, то лучше всего заменить Select и Activate на конструкцию With … End With. Например, предположим, что мы записали вот такой макрос:

Sub Macro1()
' Macro1 Macro
    Range("F4:F10,H6:H10").Select 'выбрали два несмежных диапазона зажав ctrl
    Range("H6").Activate          'показывает только то, что я начал выбирать второй диапазон с этой ячейки (она осталась белой). Это действие ни на что не влияет
    With Selection.Interior       
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535            'залили желтым цветом, нажав на кнопку заливки на верхней панели
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Почему макрос записался таким неэффективным образом? Потому что в каждый момент времени (в каждой строке) программа не знает, что вы будете делать дальше. Поэтому в записи выбор ячеек и действия с ними — это два отдельных действия. Этот код лучше всего оптимизировать (особенно если вы хотите скопировать его внутрь какого-нибудь цикла, который должен будет исполняться много раз и перебирать много объектов). Например, так:

Sub Macro11()
'
' Macro1 Macro
    Range("F4:F10,H6:H10").Select '1. смотрим, что за объект выбран (что идёт до .Select)
    Range("H6").Activate
    With Selection.Interior       '2. понимаем, что у выбранного объекта есть свойство interior, с которым далее идёт работа
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub



Sub Optimized_Macro()
    With Range("F4:F10,H6:H10").Interior '3. переносим объект напрямую в конструкцию With вместо Selection
' ////// Здесь я для надёжности прописал бы ещё Thisworkbook.Sheet("ИмяЛиста") перед Range,
' ////// чтобы минимизировать риск любых случайных изменений других листов и книг
' ////// With Thisworkbook.Sheet("ИмяЛиста").Range("F4:F10,H6:H10").Interior
        .Pattern = xlSolid               '4. полностью копируем всё, что было записано рекордером внутрь блока with
        .PatternColorIndex = xlAutomatic
        .Color = 55555                   '5. здесь я поменял цвет на зеленый, чтобы было видно, работает ли код при поочерёдном запуске двух макросов
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Пример сценария, когда использование Select и Activate оправдано:

Допустим, мы хотим, чтобы во время исполнения программы мы одновременно изменяли несколько листов одним действием и пользователь видел какой-то определённый лист. Это можно сделать примерно так:

Sub Select_Activate_is_OK()
Thisworkbook.Worksheets(Array("Sheet1", "Sheet3")).Select 'Выбираем несколько листов по именам
Thisworkbook.Worksheets("Sheet3").Activate 'Показываем пользователю третий лист
'Далее все действия с выбранными ячейками через Select будут одновременно вносить изменения в оба выбранных листа

'Допустим, что тут мы решили покрасить те же два диапазона:
Range("F4:F10,H6:H10").Select
    Range("H6").Activate
    With Selection.Interior       
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub

Единственной причиной использовать этот код по моему мнению может быть желание зачем-то показать пользователю определённую страницу книги в какой-то момент исполнения программы. С точки зрения обработки объектов, опять же, эти действия лишние.

Получение и изменение значений ячеек

Значение ячеек можно получать/изменять с помощью свойства value. 

'Если нужно прочитать / записать значение ячейки, то используется свойство Value
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value 'записать значение ячейки А1 листа "Sheet1" в переменную "a"
ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value = 1  'задать значение ячейки А1 (первый ряд, первый столбец) листа "Sheet1"

'Если нужно прочитать текст как есть (с форматированием), то можно использовать свойство .text:
ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text = "1" 
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text

'Когда проявится разница:
'Например, если мы считываем дату в формате "31 декабря 2021 г.", хранящуюся как дата
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Value 'эапишет как "31.12.2021"
a = ThisWorkbook.Sheets("Sheet1").Cells (1,1).Text  'запишет как "31 декабря 2021 г."

Ячейки открытой книги

К ячейкам можно обращаться:

'В книге, в которой хранится макрос (на каком-то из листов, либо в отдельном модуле или форме)
ThisWorkbook.Sheets("Sheet1").Cells(1,1).Value        'По номерам строки и столбца
ThisWorkbook.Sheets("Sheet1").Cells(1,"A").Value      'По номерам строки и букве столбца
ThisWorkbook.Sheets("Sheet1").Range("A1").Value       'По адресу - вариант 1
ThisWorkbook.Sheets("Sheet1").[A1].Value              'По адресу - вариант 2
ThisWorkbook.Sheets("Sheet1").Range("CellName").Value 'По имени ячейки (для этого ей предварительно нужно его присвоить)

'Те же действия, но с использованием полного названия рабочей книги (книга должна быть открыта)
Workbooks("workbook.xlsm").Sheets("Sheet1").Cells(1,1).Value 'По номерам строки и столбца
Workbooks("workbook.xlsm").Sheets("Sheet1").Cells(1,"A").Value                'По номерам строки и букве столбца
Workbooks("workbook.xlsm").Sheets("Sheet1").Range("A1").Value                 'По адресу - вариант 1
Workbooks("workbook.xlsm").Sheets("Sheet1").[A1].Value                        'По адресу - вариант 2
Workbooks("workbook.xlsm").Sheets("Sheet1").Range("CellName").Value           'По имени ячейки (для этого ей предварительно нужно его присвоить)

Ячейки закрытой книги

Если нужно достать или изменить данные в другой закрытой книге, то необходимо прописать открытие и закрытие книги. Непосредственно работать с закрытой книгой не получится, потому что данные в ней хранятся отдельно от структуры и при открытии Excel каждый раз производит расстановку значений по соответствующим «слотам» в структуре. Подробнее о том, как хранятся данные в xlsx см выше.

Workbooks.Open Filename:="С:closed_workbook.xlsx"    'открыть книгу (она становится активной)
a = ActiveWorkbook.Sheets("Sheet1").Cells(1,1).Value  'достать значение ячейки 1,1
ActiveWorkbook.Close False                            'закрыть книгу (False => без сохранения)

Скачать пример, в котором можно посмотреть, как доставать и как записывать значения в закрытую книгу. 

Код из файла:

Option Explicit
Sub get_value_from_closed_wb() 'достать значение из закрытой книги
Dim a, wb_path, wsh As String
wb_path = ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value 'get path to workbook from sheet1
wsh = ThisWorkbook.Sheets("Sheet1").Cells(3, 3).Value
Workbooks.Open Filename:=wb_path
a = ActiveWorkbook.Sheets(wsh).Cells(3, 3).Value
ActiveWorkbook.Close False
ThisWorkbook.Sheets("Sheet1").Cells(4, 3).Value = a
End Sub

Sub record_value_to_closed_wb() 'записать значение в закрытую книгу
Dim wb_path, b, wsh As String
wsh = ThisWorkbook.Sheets("Sheet1").Cells(3, 3).Value
wb_path = ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value 'get path to workbook from sheet1
b = ThisWorkbook.Sheets("Sheet1").Cells(5, 3).Value 'get value to record in the target workbook
Workbooks.Open Filename:=wb_path
ActiveWorkbook.Sheets(wsh).Cells(4, 4).Value = b 'add new value to cell D4 of the target workbook
ActiveWorkbook.Close True
End Sub

Перебор ячеек

Перебор в произвольном диапазоне

Скачать файл со всеми примерами

Пройтись по всем ячейкам в нужном диапазоне можно разными способами. Основные:

1. Цикл For Each. Пример:

   Sub iterate_over_cells()
   
   For Each c In ThisWorkbook.Sheets("Sheet1").Range("B2:D4").Cells
   MsgBox (c)
   Next c
   
   End Sub​

   Этот цикл выведет в виде сообщений значения ячеек в диапазоне B2:D4 по порядку по строкам слева направо и по столбцам — сверху вниз. Данный способ можно использовать для действий, в который вам не важны номера ячеек (закрашивание, изменение форматирования, пересчёт чего-то и т.д.).

2. Ту же задачу можно решить с помощью двух вложенных циклов — внешний будет перебирать ряды, а вложенный — ячейки в рядах. Этот способ я использую чаще всего, потому что он позволяет получить больше контроля над исполнением: на каждой итерации цикла нам доступны координаты ячеек. Для перебора всех ячеек на листе этим методом потребуется найти последнюю заполненную ячейку. Пример кода:

   Sub iterate_over_cells()
   
   Dim cl, rw As Integer
   Dim x As Variant
   
   'перебор области 3x3
   For rw = 1 To 3 ' цикл для перебора рядов 1-3
   
       For cl = 1 To 3 'цикл для перебора столбцов 1-3
           x = ThisWorkbook.Sheets("Sheet1").Cells(rw + 1, cl + 1).Value
           MsgBox (x)
       Next cl
   Next rw
   
   
   
   'перебор всех ячеек на листе. Последняя ячейка определена с помощью UsedRange
   'LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
   'LastCol = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
   'For rw = 1 To LastRow 'цикл перебора всех рядов
   '    For cl = 1 To LastCol 'цикл для перебора всех столбцов
   '        Действия 
   '    Next cl
   'Next rw
   
   
   End Sub​

3. Если нужно перебрать все ячейки в выделенном диапазоне на активном листе, то код будет выглядеть так:

   Sub iterate_cell_by_cell_over_selection()
       Dim ActSheet As Worksheet
       Dim SelRange As Range
       Dim cell As Range
       
    
       Set ActSheet = ActiveSheet
       Set SelRange = Selection
       
       'if we want to do it in every cell of the selected range
       For Each cell In Selection
       MsgBox (cell.Value)
       
       Next cell
   
   End Sub​

   Данный метод подходит для интерактивных макросов, которые выполняют действия над выбранными пользователем областями.

4. Перебор ячеек в ряду

   Sub iterate_cells_in_row()
       Dim i, RowNum, StartCell As Long
       
       RowNum = 3 'какой ряд
       StartCell = 0 ' номер начальной ячейки (минус 1, т.к. в цикле мы прибавляем i)
       
       For i = 1 To 10 ' 10 ячеек в выбранном ряду
       ThisWorkbook.Sheets("Sheet1").Cells(RowNum, i + StartCell).Value = i '(i + StartCell) добавляет 1 к номеру столбца при каждом повторении
       Next i
   
   End Sub

5. Перебор ячеек в столбце

   Sub iterate_cells_in_column()
       Dim i, ColNum, StartCell As Long
       
       ColNum = 3 'какой столбец
       StartCell = 0 ' номер начальной ячейки (минус 1, т.к. в цикле мы прибавляем i)
       
       For i = 1 To 10 ' 10 ячеек
       ThisWorkbook.Sheets("Sheet1").Cells(i + StartCell, ColNum).Value = i ' (i + StartCell) добавляет 1 к номеру ряда при каждом повторении
       Next i
   
   End Sub​

Свойства и методы ячеек

Имя ячейки

Присвоить новое имя можно так:

Thisworkbook.Sheets(1).Cells(1,1).name = "Новое_Имя"

Для того, чтобы сменить имя ячейки нужно сначала удалить существующее имя, а затем присвоить новое. Удалить имя можно так:

ActiveWorkbook.Names("Старое_Имя").Delete

Пример кода для переименования ячеек:

Sub rename_cell()

old_name = "Cell_Old_Name"
new_name = "Cell_New_Name"

ActiveWorkbook.Names(old_name).Delete
ThisWorkbook.Sheets(1).Cells(2, 1).Name = new_name
End Sub

Sub rename_cell_reverse()

old_name = "Cell_New_Name"
new_name = "Cell_Old_Name"

ActiveWorkbook.Names(old_name).Delete
ThisWorkbook.Sheets(1).Cells(2, 1).Name = new_name
End Sub

Адрес ячейки

Sub get_cell_address() ' вывести адрес ячейки в формате буква столбца, номер ряда
  '$A$1 style
  txt_address = ThisWorkbook.Sheets(1).Cells(3, 2).Address
  MsgBox (txt_address)
End Sub

Sub get_cell_address_R1C1()' получить адрес столбца в формате номер ряда, номер столбца
  'R1C1 style
  txt_address = ThisWorkbook.Sheets(1).Cells(3, 2).Address(ReferenceStyle:=xlR1C1)
  MsgBox (txt_address)
End Sub

  'пример функции, которая принимает 2 аргумента: название именованного диапазона и тип желаемого адреса 
  '(1- тип $A$1 2- R1C1 - номер ряда, столбца)
Function get_cell_address_by_name(str As String, address_type As Integer)
  '$A$1 style
  Select Case address_type
    Case 1
      txt_address = Range(str).Address
    Case 2
      txt_address = Range(str).Address(ReferenceStyle:=xlR1C1)
    Case Else
      txt_address = "Wrong address type selected. 1,2 available"
    End Select
  get_cell_address_by_name = txt_address
End Function

'перед запуском нужно убедиться, что в книге есть диапазон с названием, 
'адрес которого мы хотим получить, иначе будет ошибка
Sub test_function() 'запустите эту программу, чтобы увидеть, как работает функция
  x = get_cell_address_by_name("MyValue", 2)
  MsgBox (x)
End Sub

Размеры ячейки

Ширина и длина ячейки в VBA меняется, например, так:

Sub change_size()
Dim x, y As Integer
Dim w, h As Double

'получить координаты целевой ячейки
x = ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value
y = ThisWorkbook.Sheets("Sheet1").Cells(3, 2).Value

'получить желаемую ширину и высоту ячейки
w = ThisWorkbook.Sheets("Sheet1").Cells(6, 2).Value
h = ThisWorkbook.Sheets("Sheet1").Cells(7, 2).Value

'сменить высоту и ширину ячейки с координатами x,y
ThisWorkbook.Sheets("Sheet1").Cells(x, y).RowHeight = h
ThisWorkbook.Sheets("Sheet1").Cells(x, y).ColumnWidth = w


End Sub

Прочитать значения ширины и высоты ячеек можно двумя способами (однако результаты будут в разных единицах измерения). Если написать просто Cells(x,y).Width или Cells(x,y).Height, то будет получен результат в pt (привязка к размеру шрифта). 

Sub get_size()
Dim x, y As Integer
'получить координаты ячейки, с которой мы будем работать
x = ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value
y = ThisWorkbook.Sheets("Sheet1").Cells(3, 2).Value

'получить длину и ширину выбранной ячейки в тех же единицах измерения, в которых мы их задавали
ThisWorkbook.Sheets("Sheet1").Cells(2, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).ColumnWidth
ThisWorkbook.Sheets("Sheet1").Cells(3, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).RowHeight

'получить длину и ширину с помощью свойств ячейки (только для чтения) в поинтах (pt)
ThisWorkbook.Sheets("Sheet1").Cells(7, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).Width
ThisWorkbook.Sheets("Sheet1").Cells(8, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(x, y).Height

End Sub

Скачать файл с примерами изменения и чтения размера ячеек

Запуск макроса активацией ячейки

Для запуска кода VBA при активации ячейки необходимо вставить в код листа нечто подобное:

3 важных момента, чтобы это работало:

1. Этот код должен быть вставлен в код листа (здесь контролируется диапазон D4)

2-3. Программа, ответственная за запуск кода при выборе ячейки, должна называться Worksheet_SelectionChange и должна принимать значение переменной Target, относящейся к триггеру SelectionChange. Другие доступные триггеры можно посмотреть в правом верхнем углу (2).

Скачать файл с базовым примером (как на картинке)

Скачать файл с расширенным примером (код ниже)

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        ' имеем в виду, что триггер SelectionChange будет запускать эту Sub после каждого клика мышью (после каждого клика будет проверяться:
          '1. количество выделенных ячеек и 
          '2. не пересекается ли выбранный диапазон с заданным в этой программе диапазоном.
        ' поэтому в эту программу не стоит без необходимости писать никаких других тяжелых операций

    If Selection.Count = 1 Then 'запускаем программу только если выбрано не более 1 ячейки


    'вариант модификации - брать адрес ячейки из другой ячейки:
    'Dim CellName as String
    'CellName = Activesheet.Cells(1,1).value 'брать текстовое имя контролируемой ячейки из A1 (должно быть в формате Буква столбца + номер строки)
    'If Not Intersect(Range(CellName), Target) Is Nothing Then
    'для работы этой модификации следующую строку надо закомментировать/удалить



        If Not Intersect(Range("D4"), Target) Is Nothing Then 
        'если заданный (D4) и выбранный диапазон пересекаются 
        '(пересечение диапазонов НЕ равно Nothing)

        'можно прописать диапазон из нескольких ячеек:
        'If Not Intersect(Range("D4:E10"), Target) Is Nothing Then
        'можно прописать несколько диапазонов:
        'If Not Intersect(Range("D4:E10"), Target) Is Nothing or Not Intersect(Range("A4:A10"), Target) Is Nothing Then

            Call program 'выполняем программу
        End If
    End If
End Sub

Sub program()

MsgBox ("Program Is running") 'здесь пишем код того, что произойдёт при выборе нужной ячейки


End Sub

В данном примере описаны макросы для автоматического форматирования или спроса формата для ячеек таблиц Excel средствами VBA.

VBA-макрос: заливка, шрифт, линии границ, ширина столбцов и высота строк

В процессе запыления данных сотрудниками отдела на некоторых листах были изменены форматы ячеек:

Необходимо сбросить форматирование ячеек и сделать так чтобы на всех таблицах планов выполнения работ были одинаковые форматы отображения данных. Формат ячеек для исходной таблицы должен быть закреплен за шаблоном, чтобы можно было сделать сброс и применять заданный стиль оформления в дальнейшем.

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

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

Чтобы написать свой код макроса откройте специальный VBA-редактор в Excel: «РАЗРАБОТЧИК»-«Код»-«Visual Basic» или нажмите комбинацию клавиш ALT+F11:

В редакторе создайте новый модуль выбрав инструмент «Insert»-«Module» и введите в него такой VBA-код макроса:

Sub SbrosFormat()
If TypeName(Selection) <> "Range" Then Exit Sub
With Selection
.HorizontalAlignment = xlVAlignCenter
.VerticalAlignment = xlVAlignCenter
.WrapText = True
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexAutomatic
.Columns.AutoFit
.Rows.AutoFit
End With
End Sub


Теперь если нам нужно сбросить форматирование таблицы на исходный формат отображения ее данных, выделите диапазон ячеек A1:E20 и запустите макрос: «РАЗРАБОЧТИК»-«Код»-«Макросы»-«SbrosFormat»-«Выполнить». Результат работы макроса изображен ниже на рисунке:

Таблица приобрела формат, который определен макросом. Таким образом код VBA нам позволяет сбросить любые изменения формата ячеек на предустановленный автором отчета.



Описание VBA-макроса для формата ячеек таблицы Excel

Первая инструкция в коде, проверяет выделены ли ячейки диапазоном. Если перед выполнением макроса выделил другой элемент листа, например, график, тогда макрос закрывается и дальнейшие инструкции выполняться не будут. В противные случаи будут форматироваться все выделенные ячейки по очереди в соответствии с определенными настройками форматирования:

1. Текст в значениях ячеек выравнивается по центру горизонтально и вертикально.
2. Включен построчный перенос текста.
3. Все границы ячеек получают черную обычной толщины непрерывную линию с черным цветом.
4. Сброс цвета шрифта на авто.
5. Удаляется любая заливка ячеек.
6. Ширина столбцов автоматически настраивается под текст в ячейках.
7. Автоматически настроить высоту строк по содержимому ячеек.

Модификация исходного кода макроса для форматирования

Если необходимо сделать так чтобы текст выравнивался не по центру относительно горизонтали, а по правую сторону ячейки, тогда измените константу xlHAlignCenter на xlHAlignRight. Она находиться в свойстве .HorizontalAlignment. Сделайте это следующим образом:

.HorizontalAlignment = xlHAlignRight.

Таким же образом можно выровнять текст по левую сторону изменив значение константы на xlHAlignLeft. Или можно выровнять положение текста по ширине ячейки используя константу xlHAlignJustify.

Чтобы макрос выравнивал текст в ячейках по вертикали к низу, измените строку кода, отвечающую за данную настройку форматирования. Измените константу, которая присваивается к свойству VerticalAlignment в следующий способ:

Если хотите выровнять текс к верху ячейки, тогда воспользуйтесь константой xlHAlignTop.

Если нужно применить для границ ячеек толстую и пунктирную линию в синем цвете, смодифицируйте инструкцию, отвечающую за формат линий:

.Borders.LineStyle = xlDash

.Borders.Color = vbBlue

.Borders.Weight = xlMedium

Описание настройки форматирования для линий границ ячеек. Мы будем получать разные дополнительные типы линий границ если для свойства LineStyle присваивать такие константы:

• xlDoshDot – применяется для рисования пунктирных линий в границах ячеек;
• xlDouble – рисует двойную линию;
• xlHairLine – рисует тонкую линию;
• xlThick – для рисования очень толстой линии.

Для настройки цвета линий Excel предлагает всего 8 констант для определенных цветов. Константы для настройки цвета линий границ для свойства Color:

• vbBlack – черный;
• vbWhite – белый;
• vbRed – красный;
• vbGreen –зеленый;
• vbBlue – синий;
• vbYellow – желтый;
• vbMagenta – алый;
• vbCyan – голубой.

Но при необходимости присвоить линиям границ другие цвета можно вместо константы для свойства Color записать функцию RGB(). Достаточно лишь в аргументе этой функции указать код цвета по шкале от 0 и до 255.

Если нужно применить толстую линию только для границ выделенного диапазона, тогда перед инструкцией End With добавьте следующую строку кода:

.BorderAround xlContinuous, xlMedium, vbBlack

Описание: В первом аргументе для метода BorderAround можно записать также другой стиль линии. Во втором – толщину линии, а в третьем – цвет. Константы, которые можно присвоить в качестве значений для этих аргументов можно использовать те же, которые мы использовали для свойств: LineStyle, Weight, Color.

Если нужно экспонировать первую строку для выделенного диапазона с помощью жирного и курсивного шрифта значений ячеек. А также заполнить ячейки первой строки заливкой с голубым цветом, тогда в самом конце кода макроса перед последней инструкцией End Sub следует добавить несколько строк с VBA-кодом:

.Rows(1).Font.Bold = True

.Rows(1).Font.Italic = True

.Rows(1).Interior.Color = vbCyan

Если хотите присвоить такой же формат для не только для первой строки, но и для первого столбца выделенного диапазона, тогда скопируйте и вставьте ниже эти 3 строчки кода. После в последних трех строках измените свойство Rows на Columns.

.Columns (1).Font.Bold = True

.Columns (1).Font.Italic = True

.Columns (1).Interior.Color = vbCyan

Если нужно задать особенный формат для экспонирования последней строки выделенного диапазона, тогда измените число 1 в аргументе свойства Rows на число всех выделенных строк .Rows.Count. Например, добавьте в конец кода еще такую строку:

.Rows(.Rows.Count).Font.Bold = True

Полная версия модифицированного кода макроса выглядит так:

Sub SbrosFormat()
If TypeName(Selection) <> "Range" Then Exit Sub
With Selection
.HorizontalAlignment = xlVAlignCenter
.VerticalAlignment = xlVAlignCenter
.WrapText = True
.Borders.LineStyle = xlDash
.Borders.Color = vbBlue
.Borders.Weight = xlMedium
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexAutomatic
.Columns.AutoFit
.Rows.AutoFit
.BorderAround xlContinuous, xlMedium, vbBlack
.Rows(1).Font.Bold = True
.Rows(1).Font.Italic = True
.Rows(1).Interior.Color = vbCyan
.Columns(1).Font.Bold = True
.Columns(1).Font.Italic = True
.Columns(1).Interior.Color = vbCyan
.Rows(.Rows.Count).Font.Bold = True
End With
End Sub


Пример работы измененного кода VBA-макроса:

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

Изменение значений других ячеек из пользовательской функции VBA Excel с помощью методов Range.Replace и Application.Volatile. Примеры кода.

В первых двух параграфах описано нетрадиционное использование процедуры Function, поэтому не применяйте его в серьезных проектах. Тестирование проводилось в Excel 2016.

Функция с методом Range.Replace

Пользовательская функция не предназначена для изменения значений ячеек, кроме той, в которой она расположена. Попытка присвоить какое-либо значение из функции другой ячейке приводит к неработоспособности функции и отображению в ячейке, где она расположена, сообщения «#ЗНАЧ!».

Но, как ни странно, внутри процедуры Function работает метод Range.Replace, которым мы воспользуемся для изменения значений других ячеек из пользовательской функции.

Пример 1
Эта функция заменяет значение ячейки Cell1 на значение ячейки Cell2 увеличенное на 100. Сама функция размещается в третьей ячейке, чтобы не возникла циклическая ссылка.

Function Primer1(Cell1 As Range, Cell2 As Range)   Cell1.Replace Cell1, Cell2 + 100 End Function

В этом примере мы не присваиваем пользовательской функции значение, поэтому отображается значение по умолчанию – 0. Если объявить эту функцию как строковую: Function Primer1(Cell1 As Range, Cell2 As Range) as String, будет возвращена пустая строка.

Изменение значения ячейки C1 (Cell2) приведет к пересчету значения ячейки B1 (Cell1).

Попробуйте очистить или перезаписать ячейку B1 (Cell1), ничего не получится, так как функция Primer1 вновь перезапишет ее значением C1 (Cell2) + 100.

Метод Application.Volatile

Application.Volatile – это метод, который запускает пересчет функции при изменении значения любой ячейки рабочего листа, а не только той, которая присвоена объявленной в функции переменной. Метод Application.Volatile используется только в функциях.

Рассмотрим пересчет функции на следующем примере:

Пример 2

Function Primer2(Cell1 As Range, Cell2 As Range) As String   Cell1.Replace Cell1, Cell2 + 100   Range(«B2»).Replace Range(«B2»), Range(«C2») + Cell1 End Function

Эта функция будет пересчитываться только при изменении значений ячеек B1 и C1, присвоенных переменным Cell1 и Cell2. При изменении значения ячейки C2, значение ячейки B2 не изменится, так как не будет запущен пересчет функции Primer2.

Функция Primer2 начнет вести себя по-другому, если добавить в нее оператор Application.Volatile (переименуем ее в Primer3):

Пример 3

Function Primer3(Cell1 As Range, Cell2 As Range) As String   Application.Volatile   Cell1.Replace Cell1, Cell2 + 100   Range(«B2»).Replace Range(«B2»), Range(«C2») + Cell1 End Function

Теперь при смене значения в ячейке C2, значение ячейки B2 тоже изменится.

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

Безопасное использование функции

Если вам все-таки хочется в важном проекте VBA Excel с помощью одной пользовательской функции изменять значения нескольких ячеек, есть полностью безопасный вариант.

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

В простых случаях для выбора можно использовать функцию Choose или, в более сложных, оператор If…Then…Else и оператор Select Case.

Пример 4
Используем функцию Choose для выбора способа вычисления пользовательской функции в зависимости от значения дополнительного аргумента:

Function Primer4(Cell1 As Range, Cell2 As Range, a As Byte)   On Error Resume Next   Primer4 = Choose(a, Cell1 + Cell2, Cell1 — Cell2, Cell1 * Cell2) End Function

В функцию Primer4 добавлен дополнительный аргумент a, от которого зависит, какое действие будет произведено со значениями ячеек B1 и C1:

На следующем скриншоте представлены результаты вычисления функции в зависимости от значения аргумента a:

1. В ячейке A1 вычисляется сумма значений ячеек B1 и C1 – аргумент a=1.
2. В ячейке A2 вычисляется разность значений ячеек B2 и C2 – аргумент a=2.
3. В ячейке A3 вычисляется произведение значений ячеек B3 и C3 – аргумент a=3.

Пример 5
Используем оператор If…Then…Else в сокращенном виде (If…Then…) для выбора способа вычисления функции в зависимости от значения дополнительного аргумента:

Function Primer5(Cell1 As Range, Cell2 As Range, a As Byte)   If a = 1 Then Primer5 = Cell1 + Cell2   If a = 2 Then Primer5 = Cell1 — Cell2   If a = 3 Then Primer5 = Cell1 * Cell2 End Function

Результаты будут те же, что и в четвертом примере.

Время на прочтение
7 мин

Количество просмотров 312K

Приветствую всех.

В этом посте я расскажу, что такое VBA и как с ним работать в Microsoft Excel 2007/2010 (для более старых версий изменяется лишь интерфейс — код, скорее всего, будет таким же) для автоматизации различной рутины.

VBA (Visual Basic for Applications) — это упрощенная версия Visual Basic, встроенная в множество продуктов линейки Microsoft Office. Она позволяет писать программы прямо в файле конкретного документа. Вам не требуется устанавливать различные IDE — всё, включая отладчик, уже есть в Excel.

Еще при помощи Visual Studio Tools for Office можно писать макросы на C# и также встраивать их. Спасибо, FireStorm.

Сразу скажу — писать на других языках (C++/Delphi/PHP) также возможно, но требуется научится читать, изменять и писать файлы офиса — встраивать в документы не получится. А интерфейсы Microsoft работают через COM. Чтобы вы поняли весь ужас, вот Hello World с использованием COM.

Поэтому, увы, будем учить Visual Basic.

Чуть-чуть подготовки и постановка задачи

Итак, поехали. Открываем Excel.

Для начала давайте добавим в Ribbon панель «Разработчик». В ней находятся кнопки, текстовые поля и пр. элементы для конструирования форм.

Появилась вкладка.

Теперь давайте подумаем, на каком примере мы будем изучать VBA. Недавно мне потребовалось красиво оформить прайс-лист, выглядевший, как таблица. Идём в гугл, набираем «прайс-лист» и качаем любой, который оформлен примерно так (не сочтите за рекламу, пожалуйста):

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

Результат, которого хотим добиться, выглядит примерно так:

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

Кодим

Для начала требуется создать кнопку, при нажатии на которую будет вызываться наша програма. Кнопки находятся в панели «Разработчик» и появляются по кнопке «Вставить». Вам нужен компонент формы «Кнопка». Нажали, поставили на любое место в листе. Далее, если не появилось окно назначения макроса, надо нажать правой кнопкой и выбрать пункт «Назначить макрос». Назовём его FormatPrice. Важно, чтобы перед именем макроса ничего не было — иначе он создастся в отдельном модуле, а не в пространстве имен книги. В этому случае вам будет недоступно быстрое обращение к выделенному листу. Нажимаем кнопку «Новый».

И вот мы в среде разработки VB. Также её можно вызвать из контекстного меню командой «Исходный текст»/«View code».

Перед вами окно с заглушкой процедуры. Можете его развернуть. Код должен выглядеть примерно так:

Sub FormatPrice()End Sub

Напишем Hello World:

Sub FormatPrice()
    MsgBox "Hello World!"
End Sub

И запустим либо щелкнув по кнопке (предварительно сняв с неё выделение), либо клавишей F5 прямо из редактора.

Тут, пожалуй, следует отвлечься на небольшой ликбез по поводу синтаксиса VB. Кто его знает — может смело пропустить этот раздел до конца. Основное отличие Visual Basic от Pascal/C/Java в том, что команды разделяются не ;, а переносом строки или двоеточием (:), если очень хочется написать несколько команд в одну строку. Чтобы понять основные правила синтаксиса, приведу абстрактный код.

Примеры синтаксиса

' Процедура. Ничего не возвращает
' Перегрузка в VBA отсутствует
Sub foo(a As String, b As String)
    ' Exit Sub ' Это значит "выйти из процедуры"
    MsgBox a + ";" + b
End Sub' Функция. Вовращает Integer
Function LengthSqr(x As Integer, y As Integer) As Integer
    ' Exit Function
    LengthSqr = x * x + y * y
End FunctionSub FormatPrice()
    Dim s1 As String, s2 As String
    s1 = "str1"
    s2 = "str2"
    If s1 <> s2 Then
        foo "123", "456" ' Скобки при вызове процедур запрещены
    End IfDim res As sTRING ' Регистр в VB не важен. Впрочем, редактор Вас поправит
    Dim i As Integer
    ' Цикл всегда состоит из нескольких строк
    For i = 1 To 10
        res = res + CStr(i) ' Конвертация чего угодно в String
        If i = 5 Then Exit For
    Next iDim x As Double
    x = Val("1.234") ' Парсинг чисел
    x = x + 10
    MsgBox xOn Error Resume Next ' Обработка ошибок - игнорировать все ошибки
    x = 5 / 0
    MsgBox xOn Error GoTo Err ' При ошибке перейти к метке Err
    x = 5 / 0
    MsgBox "OK!"
    GoTo ne

Err:
    MsgBox 

"Err!"

ne:

On Error GoTo 0 ' Отключаем обработку ошибок

    ' Циклы бывает, какие захотите
    Do While True
        Exit DoLoop 'While True
    Do 'Until False
        Exit Do
    Loop Until False
    ' А вот при вызове функций, от которых хотим получить значение, скобки нужны.
    ' Val также умеет возвращать Integer
    Select Case LengthSqr(Len("abc"), Val("4"))
    Case 24
        MsgBox "0"
    Case 25
        MsgBox "1"
    Case 26
        MsgBox "2"
    End Select' Двухмерный массив.
    ' Можно также менять размеры командой ReDim (Preserve) - см. google
    Dim arr(1 to 10, 5 to 6) As Integer
    arr(1, 6) = 8Dim coll As New Collection
    Dim coll2 As Collection
    coll.Add "item", "key"
    Set coll2 = coll ' Все присваивания объектов должны производится командой Set
    MsgBox coll2("key")
    Set coll2 = New Collection
    MsgBox coll2.Count
End Sub

Грабли-1. При копировании кода из IDE (в английском Excel) есь текст конвертируется в 1252 Latin-1. Поэтому, если хотите сохранить русские комментарии — надо сохранить крокозябры как Latin-1, а потом открыть в 1251.

Грабли-2. Т.к. VB позволяет использовать необъявленные переменные, я всегда в начале кода (перед всеми процедурами) ставлю строчку Option Explicit. Эта директива запрещает интерпретатору заводить переменные самостоятельно.

Грабли-3. Глобальные переменные можно объявлять только до первой функции/процедуры. Локальные — в любом месте процедуры/функции.

Еще немного дополнительных функций, которые могут пригодится: InPos, Mid, Trim, LBound, UBound. Также ответы на все вопросы по поводу работы функций/их параметров можно получить в MSDN.

Надеюсь, что этого Вам хватит, чтобы не пугаться кода и самостоятельно написать какое-нибудь домашнее задание по информатике. По ходу поста я буду ненавязчиво знакомить Вас с новыми конструкциями.

Кодим много и под Excel

В этой части мы уже начнём кодить нечто, что умеет работать с нашими листами в Excel. Для начала создадим отдельный лист с именем result (лист с данными назовём data). Теперь, наверное, нужно этот лист очистить от того, что на нём есть. Также мы «выделим» лист с данными, чтобы каждый раз не писать длинное обращение к массиву с листами.

Sub FormatPrice()
    Sheets("result").Cells.Clear
    Sheets("data").Activate
End Sub

Работа с диапазонами ячеек

Вся работа в Excel VBA производится с диапазонами ячеек. Они создаются функцией Range и возвращают объект типа Range. У него есть всё необходимое для работы с данными и/или оформлением. Кстати сказать, свойство Cells листа — это тоже Range.

Примеры работы с Range

Sheets("result").Activate
Dim r As Range
Set r = Range("A1")
r.Value = "123"
Set r = Range("A3,A5")
r.Font.Color = vbRed
r.Value = "456"
Set r = Range("A6:A7")
r.Value = "=A1+A3"

Теперь давайте поймем алгоритм работы нашего кода. Итак, у каждой строчки листа data, начиная со второй, есть некоторые данные, которые нас не интересуют (ID, название и цена) и есть две вложенные группы, к которым она принадлежит (тип и производитель). Более того, эти строки отсортированы. Пока мы забудем про пропуски перед началом новой группы — так будет проще. Я предлагаю такой алгоритм:

1. Считали группы из очередной строки.
2. Пробегаемся по всем группам в порядке приоритета (вначале более крупные)
   1. Если текущая группа не совпадает, вызываем процедуру AddGroup(i, name), где i — номер группы (от номера текущей до максимума), name — её имя. Несколько вызовов необходимы, чтобы создать не только наш заголовок, но и всё более мелкие.
3. После отрисовки всех необходимых заголовков делаем еще одну строку и заполняем её данными.

Для упрощения работы рекомендую определить следующие функции-сокращения:

Function GetCol(Col As Integer) As String
    GetCol = Chr(Asc("A") + Col)
End FunctionFunction GetCellS(Sheet As String, Col As Integer, Row As Integer) As Range
    Set GetCellS = Sheets(Sheet).Range(GetCol(Col) + CStr(Row))
End FunctionFunction GetCell(Col As Integer, Row As Integer) As Range
    Set GetCell = Range(GetCol(Col) + CStr(Row))
End Function

Далее определим глобальную переменную «текущая строчка»: Dim CurRow As Integer. В начале процедуры её следует сделать равной единице. Еще нам потребуется переменная-«текущая строка в data», массив с именами групп текущей предыдущей строк. Потом можно написать цикл «пока первая ячейка в строке непуста».

Глобальные переменные

Option Explicit ' про эту строчку я уже рассказывал
Dim CurRow As Integer
Const GroupsCount As Integer = 2
Const DataCount As Integer = 3

FormatPrice

Sub FormatPrice()
    Dim I As Integer ' строка в data
    CurRow = 1
    Dim Groups(1 To GroupsCount) As String
    Dim PrGroups(1 To GroupsCount) As String

    Sheets(

"data").Activate
    I = 2
    Do While True
        If GetCell(0, I).Value = "" Then Exit Do
        ' ...
        I = I + 1
    Loop
End Sub

Теперь надо заполнить массив Groups:

На месте многоточия

Dim I2 As Integer
For I2 = 1 To GroupsCount
    Groups(I2) = GetCell(I2, I)
Next I2
' ...
For I2 = 1 To GroupsCount ' VB не умеет копировать массивы
    PrGroups(I2) = Groups(I2)
Next I2
I =  I + 1

И создать заголовки:

На месте многоточия в предыдущем куске

For I2 = 1 To GroupsCount
    If Groups(I2) <> PrGroups(I2) Then
        Dim I3 As Integer
        For I3 = I2 To GroupsCount
            AddHeader I3, Groups(I3)
        Next I3
        Exit For
    End If
Next I2

Не забудем про процедуру AddHeader:

Перед FormatPrice

Sub AddHeader(Ty As Integer, Name As String)
    GetCellS("result", 1, CurRow).Value = Name
    CurRow = CurRow + 1
End Sub

Теперь надо перенести всякую информацию в result

For I2 = 0 To DataCount - 1
    GetCellS("result", I2, CurRow).Value = GetCell(I2, I)
Next I2

Подогнать столбцы по ширине и выбрать лист result для показа результата

После цикла в конце FormatPrice

Sheets("Result").Activate
Columns.AutoFit

Всё. Можно любоваться первой версией.

Некрасиво, но похоже. Давайте разбираться с форматированием. Сначала изменим процедуру AddHeader:

Sub AddHeader(Ty As Integer, Name As String)
    Sheets("result").Range("A" + CStr(CurRow) + ":C" + CStr(CurRow)).Merge
    ' Чтобы не заводить переменную и не писать каждый раз длинный вызов
    ' можно воспользоваться блоком With
    With GetCellS("result", 0, CurRow)
        .Value = Name
        .Font.Italic = True
        .Font.Name = "Cambria"
        Select Case Ty
        Case 1 ' Тип
            .Font.Bold = True
            .Font.Size = 16
        Case 2 ' Производитель
            .Font.Size = 12
        End Select
        .HorizontalAlignment = xlCenter
    End With
    CurRow = CurRow + 1
End Sub

Уже лучше:

Осталось только сделать границы. Тут уже нам требуется работать со всеми объединёнными ячейками, иначе бордюр будет только у одной:

Поэтому чуть-чуть меняем код с добавлением стиля границ:

Sub AddHeader(Ty As Integer, Name As String)
    With Sheets("result").Range("A" + CStr(CurRow) + ":C" + CStr(CurRow))
        .Merge
        .Value = Name
        .Font.Italic = True
        .Font.Name = "Cambria"
        .HorizontalAlignment = xlCenterSelect Case Ty
        Case 1 ' Тип
            .Font.Bold = True
            .Font.Size = 16
            .Borders(xlTop).Weight = xlThick
        Case 2 ' Производитель
            .Font.Size = 12
            .Borders(xlTop).Weight = xlMedium
        End Select
        .Borders(xlBottom).Weight = xlMedium ' По убыванию: xlThick, xlMedium, xlThin, xlHairline
    End With
    CurRow = CurRow + 1
End Sub

Осталось лишь добится пропусков перед началом новой группы. Это легко:

В начале FormatPrice

Dim I As Integer ' строка в  data
CurRow = 0 ' чтобы не было пропуска в самом начале
Dim Groups(1 To GroupsCount) As String

В цикле расстановки заголовков

If Groups(I2) <> PrGroups(I2) Then
    CurRow = CurRow + 1
    Dim I3 As Integer

В точности то, что и хотели.

Надеюсь, что эта статья помогла вам немного освоится с программированием для Excel на VBA. Домашнее задание — добавить заголовки «ID, Название, Цена» в результат. Подсказка: CurRow = 0 CurRow = 1.

Файл можно скачать тут (min.us) или тут (Dropbox). Не забудьте разрешить исполнение макросов. Если кто-нибудь подскажет человеческих файлохостинг, залью туда.

Спасибо за внимание.

Буду рад конструктивной критике в комментариях.

UPD: Перезалил пример на Dropbox и min.us.

UPD2: На самом деле, при вызове процедуры с одним параметром скобки можно поставить. Либо использовать конструкцию Call Foo(«bar», 1, 2, 3) — тут скобки нужны постоянно.