Note: The other languages of the website are Google-translated. Back to English

Как быстро объединить соседние строки с одинаковыми данными в Excel?

Предположим, у вас есть рабочий лист с одинаковыми данными в соседних строках, и теперь вы хотите объединить те же ячейки в одну, чтобы данные выглядели аккуратно и красиво. Как быстро и удобно объединить соседние строки с одинаковыми данными? Сегодня я познакомлю вас с быстрым способом решения этой проблемы.


Объединить соседние строки с одинаковыми данными с кодом VBA

Конечно, вы можете объединить те же данные с Слияние и центр , но если нужно объединить сотни ячеек, этот метод потребует много времени. Таким образом, следующий код VBA может помочь вам легко объединить одни и те же данные.

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

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

Sub MergeSameCell()
'Updateby Extendoffice
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

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

док объединить одинаковые ячейки 2

4. Затем нажмите OK, одни и те же данные в столбце A будут объединены. Смотрите скриншот:

док объединить одинаковые ячейки 1


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

Для Объединить одинаковые ячейки полезности Kutools for Excel, вы можете быстро объединить одни и те же значения в нескольких столбцах одним щелчком мыши.

Kutools for Excel : с более чем 300 удобными надстройками Excel, бесплатно и без ограничений в течение 30 дней. 

После установки Kutools for Excel, вы можете сделать следующее:

1. Выберите столбцы, в которых вы хотите объединить соседние строки с одинаковыми данными.

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

3. А затем те же данные в выбранных столбцах были объединены в одну ячейку. Смотрите скриншот:

док объединить одинаковые ячейки 4

Нажмите, чтобы загрузить Kutools for Excel и бесплатную пробную версию сейчас!

Чтобы узнать больше об этом, посетите этот Объединить одинаковые ячейки функцию.


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

Kutools for Excel: с более чем 300 удобными надстройками Excel, которые можно попробовать бесплатно без ограничений в течение 30 дней. Загрузите и бесплатную пробную версию прямо сейчас!

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

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

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

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

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (43)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Как реплицировать макрос VBA для объединения соседних ячеек в столбцах, а не в строках? Спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Виолетта, я дублирую ряд (ниже). например например попробовать попробовать например например попробовать попробовать И изменить код на это: Next WorkRng.Parent.Range(Rng.Cells(1, i), Rng.Cells(1, j - 1)).Merge i = j - 1 It объединил строку выше с «например» и «попробовать»
Этот комментарий был сведен к минимуму модератором на сайте
для тех, кто все еще пытается достичь этого, я думаю, что у меня есть начало кода ********************************** ***** Sub MergeSameCell() 'Updateby20131127 Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "MergeSimilar" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox ("Range", xTitleId, WorkRng.Address , Тип:=8) Application.ScreenUpdating = False Application.DisplayAlerts = False 'xRows = WorkRng.Rows.Count xCols = WorkRng.Columns.Count 'Для каждого Rng в WorkRng.Columns' For i = 1 To xRows - 1 'For j = i + 1 To xRows ' If Rng.Cells(i, 1).Value Rng.Cells(j, 1).Value Then ' Exit For ' End If ' Next ' WorkRng.Parent.Range(Rng.Cells(i , 1), Rng.Cells(j - 1, 1)).Merge ' i = j - 1 ' Next 'Next Для каждого Rng в WorkRng.Rows For i = 1 To xCols - 1 For j = i + 1 To xCols Если Rng.Cells(1, i).Value Rng.Cells(1, j).Value Then Exit For End If Next WorkRng.Parent.Range(Rng.Cells(1, i), Rng.Cells(1, j - 1)).Merge i = j - 1 Next Next Application.DisplayAlerts = True Appl ication.ScreenUpdating = True End Sub **************************************** Конец кода IE Просто изменить код для замены любых ссылок на строки ссылками на столбцы
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо!!! помог мне в трудную минуту
Этот комментарий был сведен к минимуму модератором на сайте
Это было полезно мне так много раз :) Большое спасибо, это сэкономило мне много времени работы. У меня есть небольшая просьба. Я пытаюсь найти способ сделать такое же слияние, но когда под каждым значением есть пустые ячейки, чтобы объединить каждую ячейку со всеми пустыми ячейками ниже. Как изменить макрос? заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Попробуйте этот код. 8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count Для каждого Rng в WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1) ).Value Rng.Cells(j, 1).Value Then Exit For End If Next If Not IsEmpty(Rng.Cells(i, 1).Value) Or Not IsEmpty(Rng.Cells(j - 1, 1).Value) ) Затем WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge End If i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Саб
Этот комментарий был сведен к минимуму модератором на сайте
попробуйте этот код Sub MergeSameCell() Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox ("Range", xTitleId, WorkRng.Address, Type:= 8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count Для каждого Rng в WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1) ).Value Rng.Cells(j, 1).Value Then Exit For End If Next If Not IsEmpty(Rng.Cells(i, 1).Value) Or Not IsEmpty(Rng.Cells(j - 1, 1).Value) ) Затем WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge End If i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Саб
Этот комментарий был сведен к минимуму модератором на сайте
Если у меня такое же имя, ложь Раджу 1000 Раджу 2000 Мону 100 Мону 200 Тогда как я могу указать имя с суммой?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, при запуске этого макроса я получаю «Определенную приложением или объектную ошибку» в строке WorkRng.Parent.Range(rng.Cells(i, 1), rng.Cells(j - 1, 1)).Merge Any идеи как это исправить? С уважением, Михал
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю ту же ошибку. ты уже понял это? если да, то как? спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Я получаю ту же ошибку
Этот комментарий был сведен к минимуму модератором на сайте
Я оставляю здесь сценарий измененным, чтобы он объединял ячейки ниже с тем же значением или с пустой ячейкой: Sub MergeSameCell() 'Updateby20131127 Dim Rng As Range, xCell As Range Dim xRows As Integer xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Установите WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count для каждого Rng в WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(j, 1).Value "" Then If Rng.Cells(i, 1).Value Rng.Cells(j, 1).Value Then Exit For Конец, если Конец, если следующий WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge i = j - 1 Next Next Конец сабвуфера
Этот комментарий был сведен к минимуму модератором на сайте
Привет, пожалуйста, помогите. У меня проблема с кодом, с этой строкой. Ничего плохого? Если Rng.Cells(j, 1).Value "" Тогда
Этот комментарий был сведен к минимуму модератором на сайте
Всем привет. У вас должно быть: если Rng.Cells(j, 1).Value = "" тогда...
Этот комментарий был сведен к минимуму модератором на сайте
Слияние приятно. Но это требует указания диапазона при запуске кода. Я хочу указать диапазон, т.е. B1: B50 в коде vba. И сделать его выравнивание по верхнему левому краю, но как, пожалуйста, помогите.
Этот комментарий был сведен к минимуму модератором на сайте
При выполнении приведенного выше кода отображается ошибка компиляции: синтаксическая ошибка. В строке где "" используется и нижняя строка этой.
Этот комментарий был сведен к минимуму модератором на сайте
Я тоже сталкиваюсь с этой проблемой с этой строкой. Если Rng.Cells(j, 1).Value "" Тогда может кто-нибудь помочь?
Этот комментарий был сведен к минимуму модератором на сайте
привет, как я могу поставить диапазон автоматически без ввода пользователя
Этот комментарий был сведен к минимуму модератором на сайте
Извините, но у меня есть кто-то другой, кто сделает за меня сценарии, у меня нет знаний, чтобы помочь вам с модификациями.
Этот комментарий был сведен к минимуму модератором на сайте
Привет сэр, . Я пробую код vba, но он не работает. Сообщение об ошибке для .408. В частности, что комментарий WorkRng.Parent. Диапазон(rng.Cells(i, 1), rng.Cells(j - 1, 1)).Объединить. Пожалуйста, пришлите решение. Я трачу много времени на объединение документов. У меня в основном сливается этот формат ячеек C20059290. Спасибо и с уважением Пурушотхаман. С
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемый господин, . Я использую код vba для листа excel для объединения ячеек. Он не работает из-за ошибки 408. В частности, этот код WorkRng.Parent. Диапазон(rng.Cells(i, 1), rng.Cells(j - 1, 1)).Объединить. Дайте решение. Спасибо и с уважением Пурушотхаман
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Может ли кто-нибудь проинструктировать об обратном проектировании - разграничении ячеек с заполнением одинакового значения для всех.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, макрос работает, но теперь, когда я хочу отфильтровать столбец A, отображается только первая информация из столбца B, применимая к столбцу A. Глядя на пример, приведенный в макросе, если я хочу отфильтровать в понедельник после завершения слияния, будет отображаться только Николь, а информация от Люси и Лили не отображается. Есть ли строка, которую я могу добавить, чтобы избежать этого?
Этот комментарий был сведен к минимуму модератором на сайте
если вы действительно хотите фильтровать, то объединение ячеек вам не поможет.
Этот комментарий был сведен к минимуму модератором на сайте
In EXCEL INPUT NAME PRO1 PRO2 PRO3 A B C output A PRO1 A PRO2 A PRO3 B PRO1 B PRO2 B PRO3 C PRO1 C PRO2 C PRO3
Этот комментарий был сведен к минимуму модератором на сайте
Это было действительно полезно и сэкономило мое время в большей степени
Этот комментарий был сведен к минимуму модератором на сайте
Можно ли изменить код VBA, чтобы добиться того же для слияния по столбцам (в отличие от нижних строк, как указано выше), а затем повторить для всех строк?
Этот комментарий был сведен к минимуму модератором на сайте
Используйте приведенный выше код, а затем транспонируйте результат
Этот комментарий был сведен к минимуму модератором на сайте
Очень полезно !! Большое спасибо
Этот комментарий был сведен к минимуму модератором на сайте
О, приятель, ты спас много моих дней. Спасибо!!!!
Этот комментарий был сведен к минимуму модератором на сайте
В приведенной выше строке кода VBA номер 19 "i=j-1"
как это все равно повлияет на нашу логику? Я удалил это и все еще мог получить тот же результат!
Какая-то конкретная цель, почему она присутствует?
Этот комментарий был сведен к минимуму модератором на сайте
Это должно ограничить значение i последней строкой.
Пожалуйста, не обращайте внимания на этот пост!
Здесь еще нет комментариев
Загрузить ещё
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL