Прескочи на основното съдържание

Как бързо да обедините съседни редове със същите данни в Excel?

Автор: Xiaoyang Последна промяна: 2020-06-04

Да предположим, че имате работен лист с едни и същи данни в съседните редове и сега искате да обедините същите клетки в една клетка, така че данните да изглеждат чисти и красиви. Как обединявате съседни редове с едни и същи данни бързо и удобно? Днес ще ви представя един бърз начин за решаване на този проблем.


Обединяване на съседни редове от едни и същи данни с 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 за да стартирате този код, на екрана се показва диалогов прозорец за избор на диапазон, с който да работите. Вижте екранна снимка:

doc обединяване на същите клетки 2

4. След това кликнете OK, същите данни в колона A ще бъдат обединени. Вижте екранна снимка:

doc обединяване на същите клетки 1


Обединете съседни редове от едни и същи данни с Kutools за Excel

С Обединете същите клетки полезност на Kutools за Excel, можете бързо да обедините едни и същи стойности в множество колони с едно щракване.

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

След инсталиране Kutools за Excel, можете да направите следното:

1. Изберете колоните, в които искате да обедините съседните редове с едни и същи данни.

2. Щракнете Kutools > Обединяване и разделяне > Обединяване на същите клетки, вижте екранна снимка:

3. След това същите данни в избраните колони са обединени в една клетка. Вижте екранна снимка:

doc обединяване на същите клетки 4

Щракнете, за да изтеглите Kutools за Excel и безплатна пробна версия сега!

За да научите повече за това, моля посетете това Обединяване на същите клетки функция.


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

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

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии    VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар    Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки    Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание


Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
Comments (44)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
This helped me a lot. Searched a lot of sites, even Chat GPT too. But this code right here is the one. I had like thousands of data which i wanted to merge according to the data in one single column. This code helped me out. Kudos to you my good Sir!
This comment was minimized by the moderator on the site
thanks alot
This comment was minimized by the moderator on the site
How can I exit the running macro when I want to cancel the cell selection when I run the macro?
This comment was minimized by the moderator on the site
Hello, Murat,
The vba code in this article will pop out an error dialog box if you click the Cancel button, to fix this problem, please apply the below code:
Sub MergeSameCell()
'Updateby Extendoffice
On Error Resume Next
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)
If workrng Is Nothing Then
Exit Sub
End If
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



Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Hi Guys!
First of all thank you for all your support. This has been amazing and worked in past. But for some reason it is not working anymore...

My range at the moment is "$A$2:$A$126551" I am not sure if this was so large before as per user the range was larger in past as well( I am trying to help him out here). Any assistance would be great.

I get the error:
"Run-time error '6':

Overflow"

on "xRows = WorkRng.Rows.Count"

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

Additionally: When I select single date range upto row count 12547 it works but thats only for single date. I am looking to do it for all the dates in the column
This comment was minimized by the moderator on the site
Hi,
this has been amazing and worked in past. But for some reason it is not working anymore...

My range at the moment is "$A$2:$A$126551" I am not sure if this was so large before as per user the range was larger in past as well( I am trying to help him out here). Any assistance would be great.

I get the error:
"Run-time error '6':
Overflow"

on "xRows = WorkRng.Rows.Count"<sup></sup><strike></strike>
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
This comment was minimized by the moderator on the site
Thanks a lot for this macro, you saved my day, really!
This comment was minimized by the moderator on the site
A formula funciona perfeitamente para valores em colunas, mas se fossem valores para mesclar em linhas? Como seria a formula? Obrigado!!
This comment was minimized by the moderator on the site
Thanks a lot for the help. I have a followup question on this. Suppose i have the following situation:

Apple 2
Apple 2
Orange 2
Orange 2
Banana 1
Pear 1
Kiwi 1

Running the macro will cause all the '1's and the '2's to be grouped together and my total count will be 3 instead of 7. Is there a way I can merge the cells in the second column based on those in the first? Thanks in advance (:
This comment was minimized by the moderator on the site
I have the same problem, I want merge the cells in a column based on the value of another column.. Is there a solution?
This comment was minimized by the moderator on the site
This is amazing. Thank you so much for the code. Is there any addition that would make it so the segments do not merge over a page break when printing?
This comment was minimized by the moderator on the site
Hello, Kimberly,
I can't get your detailed problem, but, the below VBA code can help you to merge the same cells before and after the page break separately, please try.
If it helps you, please let me know.

Sub MergeSameCell_PageBreak()
Dim Rng As Range, xCell As Range
Dim xRows As Integer
Dim xHPB As HPageBreaks
Dim xChpb As Long
Dim xBol As Boolean
Dim xRg As Range
Set xHPB = ActiveSheet.HPageBreaks
xChpb = xHPB.Count
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
xBol = False
Set xRg = Rng.Cells(J, 1)
For xC = 1 To xChpb
If xRg.Row = xHPB.Item(xC).Location.Row Then
xBol = True
Exit For
End If
Next
If xBol Then Exit For
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
This comment was minimized by the moderator on the site
In the above VBA code line number 19 "i=j-1 "
how is it going to affect our logic anyway? I did remove that and could still able to get the same result!
Any specific purpose why it is present?
This comment was minimized by the moderator on the site
It is to limit the value i to last row.
Please disregard this post!
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations