Como transformar colunas em linhas

Question

Eu tenho uma tabela assim:

Masqueroquepareçaassim:

A lista é muito mais longa, mas eu preciso transformá-la assim. Como faço para isso?

    

Answer 1

Você pode fazer isso usando uma macro VBA

Supondo que os dados iniciem em A1 , como você mostra, com o primeiro nome na linha 1 e vários sobrenomes nas colunas abaixo; e que não há mais nada na planilha.

• Encontre a última linha / coluna dos seus dados
• Ler os dados em um array VBA (processamento muito mais rápido que ler as linhas da planilha)
• Crie um dicionário onde
  • o key de cada item é o primeiro nome
  • o item é uma coleção dos sobrenomes
• Crie uma matriz de resultados que tenha duas colunas e uma linha por sobrenome
• Escreva os resultados em uma planilha, formate a gosto.

 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

Dados de origem

Resultados