Usando a ferramenta Transpose no Excel para uma grande coluna de valores

Question

O que eu tenho é uma planilha muito grande de dados de nomes e endereços. No momento, parece semelhante a:

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

Existem centenas e centenas de grupos como este, todos separados por pelo menos uma linha em branco. Agora, posso usar a ferramenta de transposição à mão, mas isso me levaria algum tempo. Eu pensei em apenas escrever uma macro para fazer isso, no entanto, alguns endereços são três linhas, enquanto alguns são quatro linhas, por isso me confunde se isso é possível.

Existe alguma maneira simples de fazer isso sem ter que fazer tudo manualmente?

    

Answer 1

Agora, suponho que você queira que o resultado final seja semelhante ao abaixo, sem linhas entre indivíduos e o endereço completo em uma linha em uma célula

Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address

Eu também vou assumir que seus dados começam na célula A1 e que cada nome é único. se isso não acontecer, a macro precisará de alguns pequenos ajustes. defina Stopper = 50000 para a linha após seu último conjunto de dados, caso contrário, isso pode continuar por muito mais tempo do que o necessário (ou talvez não o suficiente).

Sub CollectThem()
    Dim All As New Collection
    Dim One As Variant
    Dim Addy As Variant, Stopper As Long, L1 As Integer

    Stopper = 645

    Cells(1, 1).Select
    Do Until ActiveCell.Row >= Stopper
        ReDim One(0 To 2)
        One(0) = ActiveCell.Offset(0, 0).Value
        One(1) = ActiveCell.Offset(0, 1).Value
        Addy = ""
        Do Until ActiveCell.Row >= Stopper Or (ActiveCell.Value <> "" And ActiveCell.Value <> One(0))
            Addy = Addy & ActiveCell.Offset(0, 2).Value & "|"
            ActiveCell.Offset(1, 0).Select
        Loop
        One(2) = Trim(Addy)
        All.Add One
        Erase One
    Loop

    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select

    Cells(1, 1).Select
    For Stopper = 1 To All.Count
        One = All(Stopper)
        ActiveCell.Offset(0, 0).Value = One(0)
        ActiveCell.Offset(0, 1).Value = One(1)
        Addy = Split(One(2), "|")
        If IsArray(Addy) Then
            For L1 = 0 To UBound(Addy)
                ActiveCell.Offset(0, 2 + L1).Value = Addy(L1)
            Next L1
            Erase Addy
        Else
            ActiveCell.Offset(0, 2).Value = One(2)
        End If
        ActiveCell.Offset(1, 0).Select
        Erase One
    Next Stopper
End Sub