Jak převést duplicitní řádky na sloupce v aplikaci Excel?

Předpokládejme, že máte v aplikaci Excel řadu dat, nyní byste chtěli převést duplicitní řádky do více sloupců, jak ukazuje následující snímek obrazovky, máte nějaké dobré nápady k vyřešení tohoto úkolu?

Transponujte duplicitní řádky do sloupců pomocí kódu VBA

Transponujte duplicitní řádky do sloupců pomocí kódu VBA

Bohužel neexistuje žádný přímý způsob, jak s ním zacházet v aplikaci Excel, ale můžete jej vyřešit vytvořením kódu VBA, postupujte takto:

1. Podržte stisknuté tlačítko ALT + F11 klávesy pro otevření Okno Microsoft Visual Basic pro aplikace.

2, klikněte Vložit > Modula vložte následující kód do Okno modulu.

Kód VBA: Transponujte duplicitní řádky do více sloupců

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. Pak stiskněte tlačítko F5 klíč ke spuštění tohoto kódu, vyberte rozsah dat, který chcete převést duplicitní řádky na více sloupců ve vyskakovacím dialogovém okně, viz screenshot:

4, klikněte OK, a vyberte jednu buňku, kam chcete umístit výsledek do následujícího dialogového okna, viz screenshot:

5. A pak klikněte na tlačítko OK tlačítko, vaše vybraná data byla převedena na následující:

Odemkněte kouzlo Excelu s Kutools AI

• Chytré provedení: Provádějte operace s buňkami, analyzujte data a vytvářejte grafy – to vše pomocí jednoduchých příkazů.
• Vlastní vzorce: Vytvářejte přizpůsobené vzorce pro zefektivnění vašich pracovních postupů.
• Kódování VBA: Napište a implementujte kód VBA bez námahy.
• Výklad vzorce: Snadno porozumíte složitým vzorcům.
• Překlad textu: Prolomte jazykové bariéry ve svých tabulkách.

Vylepšete své možnosti aplikace Excel pomocí nástrojů založených na umělé inteligenci. Stáhnout nyní a zažijte efektivitu jako nikdy předtím!

Související články:

Jak transponovat / převést sloupce a řádky do jednoho řádku?

Jak transponovat / převést sloupce a řádky do jednoho sloupce?

Jak transponovat / převést jeden sloupec na více sloupců v aplikaci Excel?