Добрый день! Подскажите, пожалуйста, каким образом можно искать объединённые ячейки (или проверить, есть ли объединённые ячейки) и, допустим, выделить все объединённые ячейки?
Добрый день! Подскажите, пожалуйста, каким образом можно искать объединённые ячейки (или проверить, есть ли объединённые ячейки) и, допустим, выделить все объединённые ячейки?Roman777
Sub Макрос1() Dim r As Range, r1 As Range, s$, b As Boolean Set r1 = Selection For Each r In r1 b = r.MergeCells If b Then s = s & r.Address & "|" Next
If Len(s) > 0 Then s = Left(s, Len(s) - 1) Range(Join(Split(s, "|"), " ,")).Select End If End Sub
[/vba] Выделит все обедененные ячейки в выделенном диапазоне
ЗЫ Для правильности - нужно бы использовать словарь с добавлением "mergearea"(файл 2): [vba]
Код
Sub Макрос2() Dim r As Range, r1 As Range, s$, b As Boolean, dic As Object Set dic = CreateObject("Scripting.Dictionary") Set r1 = Selection For Each r In r1 b = r.MergeCells If b Then If Not dic.Exists(r.MergeArea.Address) Then dic.Add r.MergeArea.Address, r.MergeArea.Address If b Then s = s & r.Address & "|" Next
If dic.Count > 0 Then Range(Join(dic.keys, " ,")).Select End If End Sub
[/vba]
Вот: [vba]
Код
Sub Макрос1() Dim r As Range, r1 As Range, s$, b As Boolean Set r1 = Selection For Each r In r1 b = r.MergeCells If b Then s = s & r.Address & "|" Next
If Len(s) > 0 Then s = Left(s, Len(s) - 1) Range(Join(Split(s, "|"), " ,")).Select End If End Sub
[/vba] Выделит все обедененные ячейки в выделенном диапазоне
ЗЫ Для правильности - нужно бы использовать словарь с добавлением "mergearea"(файл 2): [vba]
Код
Sub Макрос2() Dim r As Range, r1 As Range, s$, b As Boolean, dic As Object Set dic = CreateObject("Scripting.Dictionary") Set r1 = Selection For Each r In r1 b = r.MergeCells If b Then If Not dic.Exists(r.MergeArea.Address) Then dic.Add r.MergeArea.Address, r.MergeArea.Address If b Then s = s & r.Address & "|" Next
If dic.Count > 0 Then Range(Join(dic.keys, " ,")).Select End If End Sub
Например, так (предварительно выделите диапазон для поиска): [vba]
Код
Sub test() Set ma = Nothing For Each cell In Selection If cell.MergeCells Then If ma Is Nothing Then Set ma = cell Else Set ma = Union(ma, cell.MergeArea) End If End If Next If Not ma Is Nothing Then ma.Select End Sub
[/vba]
Например, так (предварительно выделите диапазон для поиска): [vba]
Код
Sub test() Set ma = Nothing For Each cell In Selection If cell.MergeCells Then If ma Is Nothing Then Set ma = cell Else Set ma = Union(ma, cell.MergeArea) End If End If Next If Not ma Is Nothing Then ma.Select End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
