Excel поиск объединенных ячеек vba - Word и Excel - помощь в работе с программами

I have an Excel document that contains duty shifts. I would like to findout if there is any merged cells like given below withing given range..

Example

How can I determine the cells are filled in given range or the cells are merged in given range?

If IsEmpty(Range("NewRange")) = False Then
    z = z + 1 'My counter 
End If

I tried IsEmpty Function but it doesnt work correctly on merged cells. You can try but the result is same.. While I got a block of empty cells there it counts as filled..

asked Feb 12, 2015 at 14:10

Berker YüceerBerker Yüceer

6,98618 gold badges67 silver badges102 bronze badges

Источник

Мне не надо искать объединенные ячейки. Это я могу
Смотри: В ячейке A1 — «Вася», A2 — «Коля» и т.д.
Запускаю процедуру поиска, например:

Visual Basic

Dim c As Range
Cells.Select
Set c = Selection.Find(What:="Коля", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then c.Select

Все окей, найдем ячейку A2.

Теперь объединяем ячейку A2 c B2.
Запускаем тот же код и Коля найден не будет, чтобы егонайти, нужно каждый раз проверять свойства ячейки, если она с чем-то объеденина, снимать объединение, потом возвращать обратно. Можно как-то просто сразу найти «Коля» в объединенной ячейке.

Источник

I’m having quite an issue with this one — I have to detect horizontally and vertically merged cells from an excel table. I have to store the first cell coords, and the lenght of the merged area. I iterate through the table with two for-cycles, line by line.

How can I use MergeArea property to detect the merged and non-merged areas?
If the cell is not merged, it should probably return empty range, however, this:

«If currentRange Is Nothing Then»

is not working at all. Any ideas?
Thanks a lot.

asked Feb 27, 2014 at 17:32

ziraelzirael

3931 gold badge3 silver badges4 bronze badges

2 Answers

There are several helpful bits of code for this.

Place your cursor in a merged cell and ask these questions in the Immidiate Window:

Is the activecell a merged cell?

? Activecell.Mergecells
 True

How many cells are merged?

? Activecell.MergeArea.Cells.Count
 2

How many columns are merged?

? Activecell.MergeArea.Columns.Count
 2

How many rows are merged?

? Activecell.MergeArea.Rows.Count
  1

What’s the merged range address?

? activecell.MergeArea.Address
  $F$2:$F$3

answered Feb 27, 2014 at 18:05

tburtbur

2,3741 gold badge13 silver badges12 bronze badges

While working with selected cells as shown by @tbur can be useful, it’s also not the only option available.

You can use Range() like so:

If Worksheets("Sheet1").Range("A1").MergeCells Then
  Do something
Else
  Do something else
End If

Or:

If Worksheets("Sheet1").Range("A1:C1").MergeCells Then
  Do something
Else
  Do something else
End If

Alternately, you can use Cells():

If Worksheets("Sheet1").Cells(1, 1).MergeCells Then
  Do something
Else
  Do something else
End If

answered May 1, 2018 at 3:09

David MetcalfeDavid Metcalfe

2,1471 gold badge27 silver badges43 bronze badges

Источник

Вы знаете, как найти и выделить все объединенные ячейки в Excel? Вот крутые хитрые способы быстро определить и выбрать все объединенные ячейки в выделении или диапазоне в Microsoft Excel 2007 и 2010.

Определите и выберите все объединенные ячейки с помощью команды Найти

Определите все объединенные ячейки с кодом VBA

Выберите и подсчитайте все объединенные ячейки с помощью Kutools for Excel

Определите и выберите все объединенные ячейки с помощью команды Найти

Вы можете определить и выбрать все объединенные ячейки на активном листе с помощью Найти команду со следующими шагами:

1, Нажмите Главная > Найти и выбрать > Найти для открытия Найти и заменить диалоговое окно. Вы также можете открыть Найти и заменить диалоговое окно с нажатием Ctrl + F ключи.

2, Нажмите Формат в диалоговом окне, (Если вы не можете узнать Формат кнопку, нажмите Опции кнопку, чтобы развернуть диалоговое окно.) см. снимок экрана:

3. В всплывающем Найти формат диалоговое окно, только отметьте Объединить ячейки вариант в Текстовый контроль Раздел под центровка вкладку и щелкните OK.

4. Теперь вы вернетесь к Найти и заменить диалоговое окно, нажмите Найти все кнопка. Все объединенные ячейки перечислены в нижней части этого диалогового окна. Выберите все результаты поиска, удерживая Shift .

Теперь при выборе всех результатов поиска выделяются все объединенные ячейки на активном листе. Смотрите скриншот:

Советы: Если вы хотите только идентифицировать, находить и выбирать объединенные ячейки в выделенном фрагменте, вам необходимо сначала выбрать диапазон.

Определите все объединенные ячейки с кодом VBA

VBA 1: определить и выделить все объединенные ячейки

1. Удерживайте ALT + F11 ключи, и он открывает Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули, и вставьте следующий макрос в Модули Окно.

Sub FindMergedcells()
'updateby Extendoffice
Dim x As Range
For Each x In ActiveSheet.UsedRange
If x.MergeCells Then
x.Interior.ColorIndex = 8
End If
Next
End Sub

3, нажмите F5 ключ для запуска этого макроса. Все объединенные ячейки в активном листе идентифицируются и выделяются, см. Снимок экрана:

VBA 2: определить и перечислить все объединенные ячейки

1. Удерживайте ALT + F11 ключи, и он открывает Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули, и вставьте следующий макрос в Модули Окно.

Sub ListMergedcells()
'updateby Extendoffice
Dim x As Range
Dim sMsg As String
sMsg = ""
For Each x In ActiveSheet.UsedRange
If x.MergeCells Then
If sMsg = "" Then
sMsg = "Merged cells:" & vbCr
End If
sMsg = sMsg & Replace(x.Address, "$", "") & vbCr
End If
Next
If sMsg = "" Then
sMsg = "No merged cells."
End If
MsgBox sMsg
End Sub

3, нажмите F5 Нажмите клавишу для запуска этого макроса, все объединенные ячейки будут перечислены во всплывающем диалоговом окне. Смотрите скриншот:

Выберите и подсчитайте все объединенные ячейки с помощью Kutools for Excel

Kutools for Excel‘s Выбрать объединенные ячейки Инструмент поможет вам идентифицировать, найти и выбрать все объединенные ячейки в выделении одним щелчком мыши.

После установки Kutools for Excel, пожалуйста, сделайте следующее Бесплатная загрузка Kutools for Excel от Yhao сейчас! )

1. Выберите диапазон данных, в котором вы хотите выделить объединенные ячейки.

2. Нажмите Кутулс > Выберите > Выбрать объединенные ячейки, см. снимок экрана:

3. И все объединенные ячейки в выделении были выбраны сразу, и количество объединенных ячеек также подсчитывается, см. Снимок экрана:

Бесплатная загрузка Kutools for Excel от Yhao сейчас!

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Источник

Поиск объединённых ячеек.

Roman777

Дата: Вторник, 02.06.2015, 10:13 |
Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация:
127
±

Замечаний:
0% ±

Excel 2007, Excel 2013

Добрый день!
Подскажите, пожалуйста, каким образом можно искать объединённые ячейки (или проверить, есть ли объединённые ячейки) и, допустим, выделить все объединённые ячейки?

Много чего не знаю!!!!

Ответить

KSV

Дата: Вторник, 02.06.2015, 10:18 |
Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация:
255
±

Замечаний:
0% ±

Excel 2013

или проверить, есть ли объединённые ячейки

[p.s.]не, так он их все объединит…

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Сообщение отредактировал KSV — Вторник, 02.06.2015, 10:34

Ответить

SLAVICK

Дата: Вторник, 02.06.2015, 10:31 |
Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация:
766
±

Замечаний:
0% ±

2019

Вот:
[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]

Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK — Вторник, 02.06.2015, 10:42

Ответить

AndreTM

Дата: Вторник, 02.06.2015, 10:40 |
Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1762

Репутация:
498
±

Замечаний:
0% ±

2003 & 2010

Например, так (предварительно выделите диапазон для поиска):
[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]

Skype: andre.tm.007
Donate: Qiwi: 9517375010

Ответить

Roman777

Дата: Вторник, 02.06.2015, 14:48 |
Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация:
127
±

Замечаний:
0% ±

Excel 2007, Excel 2013

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

Много чего не знаю!!!!

Ответить

Источник

Всем привет!
Столкнулся с проблемой, что в Excel 2013 не выполняется поиск текста программным способом из VBA и C# в объединенных ячейках . Ручной поиск выполняется нормально. Записываю макрос поиска по содержимому, поиск находит ячейки. После записи макроса, пытаюсь выполнить его в режиме отладки и вижу, что одиночная ячейка находится, а объединенная — нет.
Текст макроса:

Sub Макрос5()
'
' Макрос5 Макрос
'

'
    Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
End Sub

содержимое листа:

Ссылка на файл с макросом ge.tt/849QWKC2/v/0?c

Вопрос задан

более трёх лет назад
3264 просмотра

Потому что VBA криво работает с merge cells, и на официальном сайте экселя не рекомендуют использовать объединенные ячейки, если вы разрабатываете что-то сложное на VBA, потому что это нарушает и сортировку и цикл по ячейкам.
Можно конечно придумать костыли перебором ячеек в цикле, но большинство готовых функций обработки столбцов и рядов работать не будут.

Замените SearchOrder:=xlByColumns на SearchOrder:=xlByRows
и удалите строки Cells.FindNext(After:=ActiveCell).Activate

Пригласить эксперта

Надо произвести поиск по колонкам, то есть по столбцам.
ub Прейре_к_запису()
‘ Макрос Прейре к запису

Dim nomdoma As Object
Dim a As Object
Dim b As Object
Dim ws As Worksheet
Dim c As Object
Dim d As Object
Dim e As Integer

Set a = Workbooks(1).Worksheets(1).Range(«E18»)
Set b = Workbooks(1).Worksheets(1).Range(«E19»)

If a.Value = 12 Then
Set ws = dom12
ElseIf a.Value = 13 Then
Set ws = dom13
ElseIf a.Value = 16 Then
Set ws = dom16
ElseIf a.Value = 18 Then
Set ws = dom18
ElseIf a.Value = 20 Then
Set ws = dom20
Else
MsgBox «Нет дом с токой номером!»
Exit Sub
End If
e = ws.index ‘ е преровняется к индексу рабочего листа’
If ws.index = dom16.index And b >= 49 Then ‘MsgBox dom16.Type Обрашаемся к типу названного листа и указивем в условие if
MsgBox «В доме » & a.Value & » с номером » & _
b & » кватира не сушестьвует. Имеется 48кв! Вибирите другой номер квартиру! Ниже 49″, vbAbortRetryIgnore
Exit Sub
End If
Set nomdoma = ws.Range(«H:H»).Find(What:=b.Value, LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
ThisWorkbook.Worksheets(e).Select
Range(nomdoma.Address).Offset(rowOffset:=0, columnOffset:=-7).Select
End Sub
Используйте функцию Range(«A:A»).Find

Показать ещё
Загружается…

14 апр. 2023, в 04:52

5000 руб./за проект

14 апр. 2023, в 01:55

1000 руб./в час

13 апр. 2023, в 23:50

3000 руб./за проект

Минуточку внимания

Источник