跳到主要內容

如何在Excel中快速合併具有相同數據的相鄰行?

假設您有一個工作表,在相鄰的行中有相同的數據,現在您想將相同的單元格合併到一個單元格中,以使數據看起來整潔美觀。 如何快速方便地合併具有相同數據的相鄰行? 今天,我將向您介紹一些解決此問題的快速方法。


使用VBA代碼合併同一數據的相鄰行

當然,您可以合併相同的數據 合併與中心 命令,但是如果有數百個單元需要合併,則此方法將很耗時。 因此,以下VBA代碼可以幫助您輕鬆合併相同的數據。

1。 按住 ALT + F11 鍵,然後打開 Microsoft Visual Basic for Applications 窗口。

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 for Excel合併相同數據的相鄰行

隨著 合併相同的單元格 的效用 Excel的Kutools,您只需單擊一下即可快速合併多個列中的相同值。

Excel的Kutools : 帶有300多個便捷的Excel加載項,可以在30天內免費試用. 

安裝後 Excel的Kutools,您可以執行以下操作:

1。 選擇要合併具有相同數據的相鄰行的列。

2。 點擊 庫工具 > 合併與拆分 > 合併相同的單元格,請參見屏幕截圖:

3。 然後,所選列中的相同數據已合併到一個單元格中。 看截圖:

doc合併相同的單元格4

點擊下載Kutools for Excel並立即免費試用!

要了解更多信息,請訪問此 合併相同的單元格 功能。


演示:將相同的單元格合併到一個單元格中,或取消合併以填充重複的值:

Excel的Kutools:具有300多個方便的Excel加載項,可以在30天內免費試用,沒有任何限制。 立即下載並免費試用!

最佳辦公生產力工具

🤖 Kutools 人工智慧助手:基於以下內容徹底改變數據分析: 智慧執行   |  生成代碼  |  建立自訂公式  |  分析數據並產生圖表  |  呼叫 Kutools 函數...
熱門特色: 尋找、突出顯示或識別重複項   |  刪除空白行   |  合併列或儲存格而不遺失數據   |   沒有公式的回合 ...
超級查詢: 多條件VLookup    多值VLookup  |   跨多個工作表的 VLookup   |   模糊查詢 ....
高級下拉列表: 快速建立下拉列表   |  依賴下拉列表   |  多選下拉列表 ....
欄目經理: 新增特定數量的列  |  移動列  |  切換隱藏列的可見性狀態  |  比較範圍和列 ...
特色功能: 網格焦點   |  設計圖   |   大方程式酒吧    工作簿和工作表管理器   |  資源庫 (自動文字)   |  日期選擇器   |  合併工作表   |  加密/解密單元格    按清單發送電子郵件   |  超級濾鏡   |   特殊過濾器 (過濾粗體/斜體/刪除線...)...
前 15 個工具集12 文本 工具 (添加文本, 刪除字符,...)   |   50+ 圖表 類型 (甘特圖,...)   |   40+ 實用 公式 (根據生日計算年齡,...)   |   19 插入 工具 (插入二維碼, 從路徑插入圖片,...)   |   12 轉化 工具 (數字到單詞, 貨幣兌換,...)   |   7 合併與拆分 工具 (高級合併行, 分裂細胞,...)   |   ... 和更多

使用 Kutools for Excel 增強您的 Excel 技能,體驗前所未有的效率。 Kutools for Excel 提供了 300 多種進階功能來提高生產力並節省時間。  點擊此處獲取您最需要的功能...

產品描述


Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,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