Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Изменить формат объединенных ячеек (определенных) - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменить формат объединенных ячеек (определенных) (Макросы/Sub)
Изменить формат объединенных ячеек (определенных)
ovechkin1973 Дата: Воскресенье, 05.04.2020, 16:12 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Приветствую.. "Нарисовал" в Эксель большую схему.. сейчас возникла необходимость поменять формат некоторых элементов - объединенных ячеек в вертикальные столбики в 8 и 16 ячеек. Как можно их быстро все выделить? Ну или автоматом поменять на другой формат (цвет, заливку поменять и т.п.)
К сообщению приложен файл: _____.xlsm (29.3 Kb)


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеПриветствую.. "Нарисовал" в Эксель большую схему.. сейчас возникла необходимость поменять формат некоторых элементов - объединенных ячеек в вертикальные столбики в 8 и 16 ячеек. Как можно их быстро все выделить? Ну или автоматом поменять на другой формат (цвет, заливку поменять и т.п.)

Автор - ovechkin1973
Дата добавления - 05.04.2020 в 16:12
ovechkin1973 Дата: Воскресенье, 05.04.2020, 21:51 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Может я не верно задачу описал... со мной такое бывает. Как можно найти на листе объединенные ячейки шириной в 1 столбец и высотой 8 строк (или еще 1 столбец и 16 строк) и выделить их одновременно? чтобы можно было сразу ко всем применить форматирование нужное?


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеМожет я не верно задачу описал... со мной такое бывает. Как можно найти на листе объединенные ячейки шириной в 1 столбец и высотой 8 строк (или еще 1 столбец и 16 строк) и выделить их одновременно? чтобы можно было сразу ко всем применить форматирование нужное?

Автор - ovechkin1973
Дата добавления - 05.04.2020 в 21:51
nilem Дата: Понедельник, 06.04.2020, 07:40 | Сообщение № 3
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Типа такого, наверное:
[vba]
Код
Sub ertert()
Dim r As Range, rng As Range
Set rng = Range("A1")
For Each r In ActiveSheet.UsedRange.Cells
    If r.MergeCells Then
        ' и высотой 8 строк
        If r.MergeArea.Rows.Count = 8 Then Set rng = Union(rng, r.MergeArea)
    End If
Next r
If rng.Count > 2 Then rng.Select
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеТипа такого, наверное:
[vba]
Код
Sub ertert()
Dim r As Range, rng As Range
Set rng = Range("A1")
For Each r In ActiveSheet.UsedRange.Cells
    If r.MergeCells Then
        ' и высотой 8 строк
        If r.MergeArea.Rows.Count = 8 Then Set rng = Union(rng, r.MergeArea)
    End If
Next r
If rng.Count > 2 Then rng.Select
End Sub
[/vba]

Автор - nilem
Дата добавления - 06.04.2020 в 07:40
ovechkin1973 Дата: Понедельник, 06.04.2020, 19:29 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Типа такого, наверное:

nilem, Работает, но долго. Хотя вручную на порядки дольше будет и ошибок можно наделать. Я попробовал переделать код на объединенные ячейки высотой 16 ячеек и файл завис.. потому как много таких ячеек. Но я дождусь окончания работы макроса...


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщение
Типа такого, наверное:

nilem, Работает, но долго. Хотя вручную на порядки дольше будет и ошибок можно наделать. Я попробовал переделать код на объединенные ячейки высотой 16 ячеек и файл завис.. потому как много таких ячеек. Но я дождусь окончания работы макроса...

Автор - ovechkin1973
Дата добавления - 06.04.2020 в 19:29
nilem Дата: Понедельник, 06.04.2020, 20:29 | Сообщение № 5
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Да, долго, он ведь перебирает все ячейки в используемом диапазоне.
Нажмите Ctrl+End - выделенная ячейка будет нижний правый угол UsedRange. Попробуйте удалить ненужные строки и столбцы, чтобы уменьшить этот диапазон. Сохраните файл после этого.


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеДа, долго, он ведь перебирает все ячейки в используемом диапазоне.
Нажмите Ctrl+End - выделенная ячейка будет нижний правый угол UsedRange. Попробуйте удалить ненужные строки и столбцы, чтобы уменьшить этот диапазон. Сохраните файл после этого.

Автор - nilem
Дата добавления - 06.04.2020 в 20:29
Gustav Дата: Вторник, 07.04.2020, 01:08 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Работает, но долго

Это потому что в Union многократно добавляются повторяющиеся диапазоны - от всех составляющих их единичных ячеек. Union в конечном итоге, вроде даже как, должен уникалить список адресов внутри результирующего диапазона (можно проверить через Range.Address), но ему просто тяжело в процессе добавления повторений. Отсюда и внушительное время выполнения.

Сделал версию с предварительным отбором уникальных адресов с помощью Словаря - отрабатывает за пару-тройку секунд:
[vba]
Код
Sub ertert2()
    Dim r As Range, rng As Range, arr
    Dim odic As Object, i As Long, addr As String

    Set odic = CreateObject("Scripting.Dictionary")
    
    For Each r In ActiveSheet.UsedRange.Cells
        If r.MergeCells Then
            ' и высотой 8 строк
            If r.MergeArea.Rows.Count = 8 Then
                addr = r.MergeArea.Address(False, False)
                If Not odic.Exists(addr) Then odic.Add addr, addr
            End If
        End If
    Next r
    
    arr = odic.Keys
    Set rng = Range(arr(LBound(arr)))
    For i = LBound(arr) + 1 To UBound(arr)
        Set rng = Union(rng, Range(arr(i)))
    Next i
    
    If rng.Count > 2 Then rng.Select
End Sub
[/vba]
[p.s.]добавил arr в Dim


МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Вторник, 07.04.2020, 09:13
 
Ответить
Сообщение
Работает, но долго

Это потому что в Union многократно добавляются повторяющиеся диапазоны - от всех составляющих их единичных ячеек. Union в конечном итоге, вроде даже как, должен уникалить список адресов внутри результирующего диапазона (можно проверить через Range.Address), но ему просто тяжело в процессе добавления повторений. Отсюда и внушительное время выполнения.

Сделал версию с предварительным отбором уникальных адресов с помощью Словаря - отрабатывает за пару-тройку секунд:
[vba]
Код
Sub ertert2()
    Dim r As Range, rng As Range, arr
    Dim odic As Object, i As Long, addr As String

    Set odic = CreateObject("Scripting.Dictionary")
    
    For Each r In ActiveSheet.UsedRange.Cells
        If r.MergeCells Then
            ' и высотой 8 строк
            If r.MergeArea.Rows.Count = 8 Then
                addr = r.MergeArea.Address(False, False)
                If Not odic.Exists(addr) Then odic.Add addr, addr
            End If
        End If
    Next r
    
    arr = odic.Keys
    Set rng = Range(arr(LBound(arr)))
    For i = LBound(arr) + 1 To UBound(arr)
        Set rng = Union(rng, Range(arr(i)))
    Next i
    
    If rng.Count > 2 Then rng.Select
End Sub
[/vba]
[p.s.]добавил arr в Dim

Автор - Gustav
Дата добавления - 07.04.2020 в 01:08
ovechkin1973 Дата: Вторник, 07.04.2020, 05:25 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Да, долго, он ведь перебирает все ячейки в используемом диапазоне

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


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

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

Автор - ovechkin1973
Дата добавления - 07.04.2020 в 05:25
ovechkin1973 Дата: Вторник, 07.04.2020, 05:29 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Gustav, в вашем варианте кода ошибку выдает.. Variable not defined на строке
[vba]
Код
arr = odic.Keys
[/vba]


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеGustav, в вашем варианте кода ошибку выдает.. Variable not defined на строке
[vba]
Код
arr = odic.Keys
[/vba]

Автор - ovechkin1973
Дата добавления - 07.04.2020 в 05:29
ovechkin1973 Дата: Вторник, 07.04.2020, 05:30 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Еще не скромный вопрос - как искать объединенные ячейки шириной больше одного столбца? допустим 2 строки в 4 столбца?


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеЕще не скромный вопрос - как искать объединенные ячейки шириной больше одного столбца? допустим 2 строки в 4 столбца?

Автор - ovechkin1973
Дата добавления - 07.04.2020 в 05:30
Pelena Дата: Вторник, 07.04.2020, 07:19 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 19161
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Variable not defined
добавьте эту переменную в описание после Dim или уберите Option Explicit


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Variable not defined
добавьте эту переменную в описание после Dim или уберите Option Explicit

Автор - Pelena
Дата добавления - 07.04.2020 в 07:19
nilem Дата: Вторник, 07.04.2020, 07:57 | Сообщение № 11
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Да, можно попробовать убрать лишние Union (хотя, мне кажется, толку мало от этого - вполне себе объединяет, не напрягаясь).
Вот попробуйте с выбором кол-ва строк и столбцов и с учетом замечаний Gustav,


Вот эту строчку
[vba]
Код
If InStr(adr, .Address) = 0 Then Set rng = Union(rng, r.MergeArea)
[/vba]
надо вот так:
[vba]
Код
If InStr(adr, .Address) = 0 Then Set rng = Union(rng, r.MergeArea): adr = adr & "," & .Address
[/vba]
Забыл :)


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Вторник, 07.04.2020, 09:28
 
Ответить
СообщениеДа, можно попробовать убрать лишние Union (хотя, мне кажется, толку мало от этого - вполне себе объединяет, не напрягаясь).
Вот попробуйте с выбором кол-ва строк и столбцов и с учетом замечаний Gustav,


Вот эту строчку
[vba]
Код
If InStr(adr, .Address) = 0 Then Set rng = Union(rng, r.MergeArea)
[/vba]
надо вот так:
[vba]
Код
If InStr(adr, .Address) = 0 Then Set rng = Union(rng, r.MergeArea): adr = adr & "," & .Address
[/vba]
Забыл :)

Автор - nilem
Дата добавления - 07.04.2020 в 07:57
ovechkin1973 Дата: Вторник, 07.04.2020, 10:23 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Уважаемый nilem,
надо вот так:

файл работает 1,5 минуты

Уважаемый Gustav, Ваш вариант тоже 1,5 минуты мой файл обрабатывает.


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

Сообщение отредактировал ovechkin1973 - Вторник, 07.04.2020, 10:24
 
Ответить
СообщениеУважаемый nilem,
надо вот так:

файл работает 1,5 минуты

Уважаемый Gustav, Ваш вариант тоже 1,5 минуты мой файл обрабатывает.

Автор - ovechkin1973
Дата добавления - 07.04.2020 в 10:23
Gustav Дата: Вторник, 07.04.2020, 12:04 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
файл работает 1,5 минуты

А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
файл работает 1,5 минуты

А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?

Автор - Gustav
Дата добавления - 07.04.2020 в 12:04
ovechkin1973 Дата: Вторник, 07.04.2020, 13:17 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?

точно не засекал, но дома могу попробовать. Прикручу к файлу таймер, где то в других проектах был... на работе сейчас часами засекал время..
А так примерно несколько минут работал файл на поиске 1*8 объединенных ячееек, а на 1*16 комп завис..


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщение
А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?

точно не засекал, но дома могу попробовать. Прикручу к файлу таймер, где то в других проектах был... на работе сейчас часами засекал время..
А так примерно несколько минут работал файл на поиске 1*8 объединенных ячееек, а на 1*16 комп завис..

Автор - ovechkin1973
Дата добавления - 07.04.2020 в 13:17
nilem Дата: Вторник, 07.04.2020, 13:42 | Сообщение № 15
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
С отключенным обновлением работает быстрее.
Казалось бы... ?


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеС отключенным обновлением работает быстрее.
Казалось бы... ?

Автор - nilem
Дата добавления - 07.04.2020 в 13:42
Gustav Дата: Вторник, 07.04.2020, 22:17 | Сообщение № 16
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Узрел возможность сократить время выполнения за счет отказа от цикла по всем ячейкам в пользу двух вложенных циклов - по строкам и по столбцам - с шагами (внимание!), равными размерам искомых объединенных ячеек. Т.е., фигурально выражаясь, протыкаем (щупаем) копну сена спицей не по каждой строке, а по каждой "восьмой" строке, с гарантированным попаданием хотя бы в одну простую ячейку (а больше и не надо) из состава объединенной ячейки (в терминах "морского боя": подбиваем одну из труб большого корабля с тем, чтобы затем утопить весь корабль).

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



МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Вторник, 07.04.2020, 22:17
 
Ответить
СообщениеУзрел возможность сократить время выполнения за счет отказа от цикла по всем ячейкам в пользу двух вложенных циклов - по строкам и по столбцам - с шагами (внимание!), равными размерам искомых объединенных ячеек. Т.е., фигурально выражаясь, протыкаем (щупаем) копну сена спицей не по каждой строке, а по каждой "восьмой" строке, с гарантированным попаданием хотя бы в одну простую ячейку (а больше и не надо) из состава объединенной ячейки (в терминах "морского боя": подбиваем одну из труб большого корабля с тем, чтобы затем утопить весь корабль).

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


Автор - Gustav
Дата добавления - 07.04.2020 в 22:17
ovechkin1973 Дата: Среда, 08.04.2020, 05:07 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?

Проверил макрос из поста №3 - работает на поиске и выделении 8ми ячеек 7,6 секунд примерно, а на поиске 16ти ячеек - 21 секунда. Но каждый запуск почему то дает чуть разное время (плюс-минус секунда примерно). К макросу добавил:


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщение
А вчера сколько? При выполнении самой первой редакции макроса из сообщения №3 - да на Вашем боевом файле?

Проверил макрос из поста №3 - работает на поиске и выделении 8ми ячеек 7,6 секунд примерно, а на поиске 16ти ячеек - 21 секунда. Но каждый запуск почему то дает чуть разное время (плюс-минус секунда примерно). К макросу добавил:

Автор - ovechkin1973
Дата добавления - 08.04.2020 в 05:07
ovechkin1973 Дата: Среда, 08.04.2020, 05:14 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Продолжаю использовать фрагменты кода nilem

этот код работает 1,22 и 1,39 секунд соответственно! Супер!


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
Сообщение
Продолжаю использовать фрагменты кода nilem

этот код работает 1,22 и 1,39 секунд соответственно! Супер!

Автор - ovechkin1973
Дата добавления - 08.04.2020 в 05:14
ovechkin1973 Дата: Среда, 08.04.2020, 05:19 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 429
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Огромное спасибо за помощь! Но аппетит разыгрался.. можно ли таким же макросом картинки одинаковые выделить? допустим круги?


Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
 
Ответить
СообщениеОгромное спасибо за помощь! Но аппетит разыгрался.. можно ли таким же макросом картинки одинаковые выделить? допустим круги?

Автор - ovechkin1973
Дата добавления - 08.04.2020 в 05:19
Pelena Дата: Среда, 08.04.2020, 09:11 | Сообщение № 20
Группа: Админы
Ранг: Местный житель
Сообщений: 19161
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Этот вопрос не относится к данной теме


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЭтот вопрос не относится к данной теме

Автор - Pelena
Дата добавления - 08.04.2020 в 09:11
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменить формат объединенных ячеек (определенных) (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!