Всем привет))) На этот раз вот такой вопросик. Например я по вертикале объединил несколько ячеек. Необходимо написать функцию которая будет подсчитывать количество объединенных ячеек. Ну и работать она должна примерно так.
Задается первая по порядку (сверху в низ) ячейка из какого то количества обедненных ячеек. Заводится счетчик , который и будет подсчитываться количество ячеек. Ну и потом циклически надо идти в низ пока "объединена ячейка" не закончится.
По факту у меня загвоздка в условии остановки цикла))
Всем привет))) На этот раз вот такой вопросик. Например я по вертикале объединил несколько ячеек. Необходимо написать функцию которая будет подсчитывать количество объединенных ячеек. Ну и работать она должна примерно так.
Задается первая по порядку (сверху в низ) ячейка из какого то количества обедненных ячеек. Заводится счетчик , который и будет подсчитываться количество ячеек. Ну и потом циклически надо идти в низ пока "объединена ячейка" не закончится.
По факту у меня загвоздка в условии остановки цикла))
Что-то у меня замороченно, ИМХО, получается... Явно можно проще... Но пока так:
Code
Sub MergeCells_Count() Dim rCell As Range, i&, sAddress$ For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If rCell.MergeArea.Address <> sAddress Then sAddress = rCell.MergeArea.Address i = i + 1 End If End If Next MsgBox i End Sub
Что-то у меня замороченно, ИМХО, получается... Явно можно проще... Но пока так:
Code
Sub MergeCells_Count() Dim rCell As Range, i&, sAddress$ For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If rCell.MergeArea.Address <> sAddress Then sAddress = rCell.MergeArea.Address i = i + 1 End If End If Next MsgBox i End Sub
Sub MergeCells_Count2() Dim rCell As Range, rRange As Range For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If rRange Is Nothing Then Set rRange = rCell.MergeArea Else Set rRange = Union(rRange, rCell.MergeArea) End If End If Next MsgBox rRange.Areas.Count End Sub
но тоже, ИМХО, как-то сложновато.
Можно, конечно, и так:
Code
Sub MergeCells_Count2() Dim rCell As Range, rRange As Range For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If rRange Is Nothing Then Set rRange = rCell.MergeArea Else Set rRange = Union(rRange, rCell.MergeArea) End If End If Next MsgBox rRange.Areas.Count End Sub
With New Dictionary ' Раннее связывание, нужен Reference на MS Scripting Runtime
For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If Not .Exists(rCell.MergeArea.Address) Then .Add rCell.MergeArea.Address, 0 End If Next MsgBox .Count End With End Sub
Можно чуть сократить, ты умеешь
Алексей, а если адреса в словарь?
Code
Sub MergeCells_CountDic() Dim rCell As Range
With New Dictionary ' Раннее связывание, нужен Reference на MS Scripting Runtime
For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then If Not .Exists(rCell.MergeArea.Address) Then .Add rCell.MergeArea.Address, 0 End If Next MsgBox .Count End With End Sub
Игорь, хоть я и люблю словари (ты на это намекаешь, как я понял?) но не настолько же чтобы "из пушки по воробьям" KuklP, Серёга, если бы ножно было посчитать общее число ячеек в объединённых областях, то никто бы с циклами, естественно, не заморачивался... Аналогичное твоему предложению решение у меня получилось уже через пару минут после того, как решил попробовать помочь. Но я подумал, что с таким элементарным вопросом топик-стартер обращаться бы не стал.
Хотя... Michelangelo поставил вопрос так, что трудно точно понять, что он хочет, посчитать кол-во ячеек в объединённых областях или кол-во объединенных областей.
Quote (Hugo)
Алексей, а если адреса в словарь?
Игорь, хоть я и люблю словари (ты на это намекаешь, как я понял?) но не настолько же чтобы "из пушки по воробьям" KuklP, Серёга, если бы ножно было посчитать общее число ячеек в объединённых областях, то никто бы с циклами, естественно, не заморачивался... Аналогичное твоему предложению решение у меня получилось уже через пару минут после того, как решил попробовать помочь. Но я подумал, что с таким элементарным вопросом топик-стартер обращаться бы не стал.
Хотя... Michelangelo поставил вопрос так, что трудно точно понять, что он хочет, посчитать кол-во ячеек в объединённых областях или кол-во объединенных областей.
Попробую переформулировать вопрос...))) Нужно посчитать количество обедненных ячеек в области отдельно по вертикали(по столбцу), и отдельно по горизонтале (по строке).
Ну на всякий случай пример. Например объединяю диапазон А1:B4 . в этом случае функция по горизантале должна вернуть 2, а функция по вертикале 4
Попробую переформулировать вопрос...))) Нужно посчитать количество обедненных ячеек в области отдельно по вертикали(по столбцу), и отдельно по горизонтале (по строке).
Ну на всякий случай пример. Например объединяю диапазон А1:B4 . в этом случае функция по горизантале должна вернуть 2, а функция по вертикале 4
Только у меня такой вариант функции Сергея получился :
Code
Public Function MyMergeCount2(cMerge As Range) Dim cc As Range For Each cc In cMerge With cc.MergeArea If .MergeCells Then MyMergeCount2 = MyMergeCount2 + 1 End If End With Next End Function
P.S. Попроще можно (вложение заменил):
Code
Public Function MyMergeCount2(cMerge As Range) Dim cc As Range For Each cc In cMerge If cc.MergeCells Then MyMergeCount2 = MyMergeCount2 + 1 End If Next End Function
Только у меня такой вариант функции Сергея получился :
Code
Public Function MyMergeCount2(cMerge As Range) Dim cc As Range For Each cc In cMerge With cc.MergeArea If .MergeCells Then MyMergeCount2 = MyMergeCount2 + 1 End If End With Next End Function
P.S. Попроще можно (вложение заменил):
Code
Public Function MyMergeCount2(cMerge As Range) Dim cc As Range For Each cc In cMerge If cc.MergeCells Then MyMergeCount2 = MyMergeCount2 + 1 End If Next End Function
И, к стати, если уж использовать словари, то, наверное, лучше так:
Code
Function MergeAreas(rRange As Range) Dim rCell As Range With CreateObject("Scripting.Dictionary") ' создаем временный словарь For Each rCell In Intersect(rRange, ActiveSheet.UsedRange) If rCell.MergeCells Then .Item(rCell.MergeArea.Address) = "" ' попытка записи значения по отсутствующему ключу добавит ключ в словарь End If Next MergeAreas = .Count End With End Function
или так:
Code
Sub MergeCells_CountDic() Dim rCell As Range With CreateObject("Scripting.Dictionary") ' создаем временный словарь For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then .Item(rCell.MergeArea.Address) = "" ' попытка записи значения по отсутствующему ключу добавит ключ в словарь End If Next MsgBox .Count End With End Sub
И, к стати, если уж использовать словари, то, наверное, лучше так:
Code
Function MergeAreas(rRange As Range) Dim rCell As Range With CreateObject("Scripting.Dictionary") ' создаем временный словарь For Each rCell In Intersect(rRange, ActiveSheet.UsedRange) If rCell.MergeCells Then .Item(rCell.MergeArea.Address) = "" ' попытка записи значения по отсутствующему ключу добавит ключ в словарь End If Next MergeAreas = .Count End With End Function
или так:
Code
Sub MergeCells_CountDic() Dim rCell As Range With CreateObject("Scripting.Dictionary") ' создаем временный словарь For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then .Item(rCell.MergeArea.Address) = "" ' попытка записи значения по отсутствующему ключу добавит ключ в словарь End If Next MsgBox .Count End With End Sub
Public Function MyMergeCount(cMerge As Range) As String MyMergeCount = UBound(cMerge.MergeArea.Formula) & ", " & UBound(cMerge.MergeArea.Formula, 2) End Function
Через запятую к-во строк, столбцов.
В одну строчку:
Code
Public Function MyMergeCount(cMerge As Range) As String MyMergeCount = UBound(cMerge.MergeArea.Formula) & ", " & UBound(cMerge.MergeArea.Formula, 2) End Function
Серёга, попытался разобраться в твоей формуле - не понял, что должно вернуть UBound(cMerge.MergeArea.Formula) ? Как это ты у возвращаемой формулы в нотации А1 определяешь верхнюю границу массива? При этом в одной и той же строке сначала - одномерного, а потом двумерного? Решил, что должно дать ошибку. Засомневался в своих теоретических знаниях. Решил проверить на практике - попробовал тупо вставить в стандартный модуль. Как и ожидал - ошибка. В модуль листа - тоже. Что-то ты либо недописал, либо перемудрил.
Quote (KuklP)
В одну строчку
Серёга, попытался разобраться в твоей формуле - не понял, что должно вернуть UBound(cMerge.MergeArea.Formula) ? Как это ты у возвращаемой формулы в нотации А1 определяешь верхнюю границу массива? При этом в одной и той же строке сначала - одномерного, а потом двумерного? Решил, что должно дать ошибку. Засомневался в своих теоретических знаниях. Решил проверить на практике - попробовал тупо вставить в стандартный модуль. Как и ожидал - ошибка. В модуль листа - тоже. Что-то ты либо недописал, либо перемудрил.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Четверг, 03.03.2011, 09:26
Да, действительно... Просто я чтобы не связываться с листом, проверял твою функцию с помощью
Code
Sub ttt() Debug.Print MyMergeCount(ActiveSheet.[A1]) End Sub
А ActiveSheet когда пробовал в модуле листа опустил. Вот и не работало.
Но всё равно НЕ ПОНИМАЮ что воэвращает UBound(cMerge.MergeArea.Formula) ? Ведь .Formula "Returns or sets the object's formula in A1-style notation and in the language of the macro"
МАССИВОМ (а ведь это должен быть массив, иначе какой же у него UBound ?) какой размерности является значение, возвращаемое cMerge.MergeArea.Formula ? Если одномерный, то почему не ругается UBound по второму измерению? А если двумерный, то почему не ругается UBound без указания измерения?
Да, действительно... Просто я чтобы не связываться с листом, проверял твою функцию с помощью
Code
Sub ttt() Debug.Print MyMergeCount(ActiveSheet.[A1]) End Sub
А ActiveSheet когда пробовал в модуле листа опустил. Вот и не работало.
Но всё равно НЕ ПОНИМАЮ что воэвращает UBound(cMerge.MergeArea.Formula) ? Ведь .Formula "Returns or sets the object's formula in A1-style notation and in the language of the macro"
МАССИВОМ (а ведь это должен быть массив, иначе какой же у него UBound ?) какой размерности является значение, возвращаемое cMerge.MergeArea.Formula ? Если одномерный, то почему не ругается UBound по второму измерению? А если двумерный, то почему не ругается UBound без указания измерения?
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
