如何在Excel中将重复的行转置为列？

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

最佳办公生产力工具

在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。 每天将您的工作效率提高50％，并减少数百次鼠标单击！