Hoppa till huvudinnehåll

Hur transponerar man dubbla rader till kolumner i Excel?

Om du antar att du har en rad data i Excel, nu vill du transponera de dubbla raderna till flera kolumner enligt följande skärmdump, har du några bra idéer för att lösa den här uppgiften?

Transponera dubbla rader till kolumner med VBA-kod

doc-convert-duplicate-rows-columns-1


pil blå höger bubbla Transponera dubbla rader till kolumner med VBA-kod

Tyvärr finns det inget direkt sätt för dig att hantera det i Excel, men du kan skapa en VBA-kod för att lösa den, gör så här:

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic for Applications-fönstret.

2. Klicka Insert > Modulernaoch klistra in följande kod i Modulfönster.

VBA-kod: Transponera dubbletterader till flera kolumner

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. Tryck sedan på F5 nyckel för att köra den här koden, välj det dataområde som du vill konvertera dubbletteraderna till flera kolumner i dialogrutan poppade ut, se skärmdump:

doc-convert-duplicate-rows-columns-2

4. Klicka OK, och välj en cell där du vill placera resultatet i följande dialogruta, se skärmdump:

doc-convert-duplicate-rows-columns-3

5. Och klicka sedan på OK knappen har dina valda data konverterats till följande:

doc-convert-duplicate-rows-columns-4


Relaterade artiklar:

Hur transponerar / konverterar man kolumner och rader till en rad?

Hur transponerar / konverterar jag kolumner och rader till en kolumn?

Hur transponerar / konverterar jag en enda kolumn till flera kolumner i Excel?

Bästa kontorsproduktivitetsverktyg

🤖 Kutools AI Aide: Revolutionera dataanalys baserat på: Intelligent utförande   |  Generera kod  |  Skapa anpassade formler  |  Analysera data och generera diagram  |  Anropa Kutools funktioner.
Populära funktioner: Hitta, markera eller identifiera dubbletter   |  Ta bort tomma rader   |  Kombinera kolumner eller celler utan att förlora data   |   Rund utan formel ...
Superuppslag: Flera kriterier VLookup    VLookup med flera värden  |   VSök över flera ark   |   Fuzzy Lookup ....
Avancerad rullgardinslista: Skapa snabbt en rullgardinslista   |  Beroende rullgardinslista   |  Flervals-rullgardinslista ....
Kolumnhanterare: Lägg till ett specifikt antal kolumner  |  Flytta kolumner  |  Växla synlighetsstatus för dolda kolumner  |  Jämför intervall och kolumner ...
Utvalda funktioner: Rutnätsfokus   |  Designvy   |   Stor formelbar    Arbetsbok & Bladhanterare   |  Resursbibliotek (Automatisk text)   |  Datumväljare   |  Kombinera arbetsblad   |  Kryptera/Dekryptera celler    Skicka e-postmeddelanden efter lista   |  Superfilter   |   Specialfilter (filtrera fet/kursiv/genomstruken...) ...
Topp 15 verktygssatser12 text verktyg (lägga till text, Ta bort tecken, ...)   |   50+ Diagram Typer (Gantt Chart, ...)   |   40+ Praktiskt Formler (Beräkna ålder baserat på födelsedag, ...)   |   19 Införande verktyg (Infoga QR-kod, Infoga bild från sökväg, ...)   |   12 Konvertering verktyg (Siffror till ord, Valutaväxling, ...)   |   7 Slå ihop och dela verktyg (Avancerade kombinera rader, Dela celler, ...)   |   ... och mer

Uppgradera dina Excel-färdigheter med Kutools för Excel och upplev effektivitet som aldrig förr. Kutools för Excel erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid.  Klicka här för att få den funktion du behöver mest...

Beskrivning


Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!

 

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