Как преобразовать столбцы в строки

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

Источник данных

Результаты