跳到主要內容

如何在Excel中將重複的行轉置為列?

假設您在Excel中擁有一系列數據,現在,您希望將重複的行轉換為多列,如下面的屏幕快照所示,您有解決此任務的好主意嗎?

使用VBA代碼將重複的行轉換為列

文檔轉換重複行列1


箭頭藍色右氣泡 使用VBA代碼將重複的行轉換為列

不幸的是,您沒有直接的方法可以在Excel中處理它,但是您可以創建一個VBA代碼來解決它,請執行以下操作:

1. 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications窗口.

2。 點擊 插入 > 模塊,然後將以下代碼粘貼到 模塊窗口.

VBA代碼:將重複的行轉置為多列

Sub ConvertTable()
'Updateby Extendoffice
Dim xArr1 As Variant
Dim xArr2 As Variant
Dim InputRng As Range, OutRng As Range
Dim xRows As Long
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
xArr1 = InputRng.Value
t = UBound(xArr1, 2): xRows = 1
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(xArr1, 1)
        If Not .exists(xArr1(i, 1)) Then
            xRows = xRows + 1: .Item(xArr1(i, 1)) = VBA.Array(xRows, t)
            For ii = 1 To t
                xArr1(xRows, ii) = xArr1(i, ii)
            Next
        Else
            xArr2 = .Item(xArr1(i, 1))
            If UBound(xArr1, 2) < xArr2(1) + t - 1 Then
                ReDim Preserve xArr1(1 To UBound(xArr1, 1), 1 To xArr2(1) + t - 1)
                For ii = 2 To t
                    xArr1(1, xArr2(1) + ii - 1) = xArr1(1, ii)
                Next
            End If
            For ii = 2 To t
                xArr1(xArr2(0), xArr2(1) + ii - 1) = xArr1(i, ii)
            Next
            xArr2(1) = xArr2(1) + t - 1: .Item(xArr1(i, 1)) = xArr2
        End If
    Next
End With
OutRng.Resize(xRows, UBound(xArr1, 2)).Value = xArr1
End Sub

3。 然後按 F5 鍵以運行此代碼,在彈出的對話框中選擇要將重複的行轉換為多列的數據范圍,請參見屏幕截圖:

文檔轉換重複行列2

4。 點擊 OK,然後在以下對話框中選擇要將結果放入其中的一個單元格,請參見屏幕截圖:

文檔轉換重複行列3

5. 然後點擊 OK 按鈕,您選擇的數據已轉換為以下內容:

文檔轉換重複行列4


相關文章:

如何將列和行轉置/轉換為單行?

如何將列和行轉置/轉換為單列?

如何在Excel中將單個列轉置/轉換為多個列?

最佳辦公生產力工具

🤖 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 (8)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello everyone

I have tried this code and it worked successfully.

My question is How could i do the same using Ms Access for bigger data could i get a query works the same or not ?

Thank you so much .
This comment was minimized by the moderator on the site
Hello! Can anyone help me...

I found this code to turn rows of data with a unique ID into a single row per ID with multiple columns (min column 5 - including ID, maximum columns 25 - including ID). Then it deletes all of the duplicate rows based on unique ID. This code sort of works, the only problem is it isn't transferring two columns of data.

The number of rows of data per unique ID varies from 1 to 6 (therefore I would need minimum 5 columns to maximum 25 columns)

There are 20,000 rows of data but I can break the data up by department for a minimum of 5,000 rows of data and run each department separately.

Thanks for your help!


My data looks something like this

A B C D E
ID DESCRIPTION STATE # DATE
3 CPR US 567 6/19/2019
3 AET US 568 6/19/2019
4 CPR US 6/19/2019
4 AET
4 AED

etc.

I want it to look like this

A B C D E F G H I J K L M ETC.....
ID DESCRIPTION STATE # DATE DESCRIPTION STATE # DATE DESCRIPTION STATE # DATE
3 CPR US 567 6/19/2019 AET US 568 6/19/2019
4 CPR US AET US AED US

Here is the code I found that sort of works (probably for what it was written for, it carries over only the data in columns D and E and omits column B & C... leaving two blank columns per data set. I like that it deletes the duplicates after moving all of the data to a single column based on unique ID

Sub Addresses_To_Columns()

Dim lastRow As Long
Dim addressCount As Integer: addressCount = 0

lastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = lastRow To 3 Step -1
If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
addressCount = addressCount + 1
Range(Cells(i - 1, 10), Cells(i - 1, (addressCount * 5) + 10)) = Range(Cells(i, 4), Cells(i, (addressCount * 5) + 4)).Value
Rows(i).Delete
Else
addressCount = 0
End If
Next i

End Sub
This comment was minimized by the moderator on the site
This works fine for me with different number of duplicates Brian. I only had a problem with the first duplicate showing twice on my output, but that was very minor. I only wish I knew how to make it copy the duplicate results into a comma delimited format instead of new columns for each one.
This comment was minimized by the moderator on the site
Only works if there's the same number of duplicates and call him a. It doesn't work at if have different numbers of duplicates.
This comment was minimized by the moderator on the site
Really great. Saved me a lot of time
This comment was minimized by the moderator on the site
I am so incredibly happy this worked. You are my hero!!!!
This comment was minimized by the moderator on the site
Awesome Example - saved me a lot of time. Thank You so much !!!
This comment was minimized by the moderator on the site
Thanks a lot!

God Bless you.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations