如何将列转换为行

Question

我有一张如下所示的表格：

但我想让它看起来像这样：

这个列表很长，但我需要像这样转换它。我该如何实现？

Answer 1

您可以使用 VBA 宏来执行此操作

假设数据从 开始A1，如您所显示，名字在第 1 行，多个姓氏在下面的列中；并且工作表上没有其他内容。

• 找到数据的最后一行/列
• 将数据读入 VBA 数组（处理速度比从工作表读取行快得多）
• 创建一个词典，其中
  • 每个key项目都是名字
  • 这item是姓氏的集合
• 创建一个包含两列且每个姓氏一行的结果数组
• 将结果写入工作表，并按需要设置格式。

---

 Option Explicit
Sub GroupFirstName()
    Dim wsSrc As Worksheet, wsRes  As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim dFN As Object, cLN As Collection
    Dim I As Long, J As Long
    Dim LRC() As Long
    Dim V, W

'Set source and results worksheets
'  Edit sheetnames as required
Set wsSrc = Worksheets("Sheet2")
Set wsRes = Worksheets("Sheet3")
    Set rRes = wsRes.Cells(1, 1) 'Upper left cell of results

'Read source data into variant array
With wsSrc
    LRC = LastRowCol(.Name)
    vSrc = .Range(.Cells(1, 1), .Cells(LRC(0), LRC(1)))
End With

'create dictionary with key = first name, and item is a collection of the last names
Set dFN = CreateObject("Scripting.Dictionary")
    dFN.CompareMode = TextCompare
For J = 1 To UBound(vSrc, 2)
    If Not dFN.Exists(vSrc(1, J)) Then
        Set cLN = New Collection
            For I = 2 To UBound(vSrc, 1)
                If vSrc(I, J) <> "" Then cLN.Add vSrc(I, J)
            Next I
            dFN.Add Key:=vSrc(1, J), Item:=cLN
    Else
            For I = 2 To UBound(vSrc, 1)
                If vSrc(I, J) <> "" Then dFN(vSrc(1, J)).Add vSrc(I, J)
            Next I
    End If
Next J

'Create results array
' Num rows = number of last names
J = 0
For Each V In dFN.Keys
    J = J + dFN(V).Count
Next V

ReDim vRes(0 To J, 1 To 2)
    vRes(0, 1) = "First Name"
    vRes(0, 2) = "Last Name"

I = 0
For Each V In dFN.Keys
    For Each W In dFN(V)
        I = I + 1
        vRes(I, 1) = V
        vRes(I, 2) = W
    Next W
Next V

Set rRes = rRes.Resize(UBound(vRes, 1) + 1, 2)
With rRes
    .EntireColumn.Clear
    .Value = vRes
    With .Rows(1)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    .EntireColumn.AutoFit
End With

End Sub

Private Function LastRowCol(Worksht As String) As Long()
Application.Volatile
    Dim WS As Worksheet, R As Range
    Dim LastRow As Long, LastCol As Long
    Dim L(1) As Long
Set WS = Worksheets(Worksht)
With WS
    Set R = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByRows, _
                    searchdirection:=xlPrevious)

    If Not R Is Nothing Then
        LastRow = R.Row
        LastCol = .Cells.Find(what:="*", after:=.Cells(1, 1), _
                    LookIn:=xlValues, searchorder:=xlByColumns, _
                    searchdirection:=xlPrevious).Column
    Else
        LastRow = 1
        LastCol = 1
    End If
End With

L(0) = LastRow
L(1) = LastCol
LastRowCol = L
End Function

源数据

结果