☰

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

tag-icon • tag-icon microsoft-excel vba
Usando a ferramenta Transpor no Excel para uma grande coluna de valores

O que tenho é uma planilha muito grande com dados de nomes e endereços. No momento, é 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 manualmente, mas isso levaria algum tempo. Pensei em apenas escrever uma macro para fazer isso, porém alguns endereços têm três linhas e outros têm quatro linhas, então fico confuso se isso é possível.

Alguma maneira simples de fazer isso sem ter que fazer tudo manualmente?

Responder1

Agora, presumo que você deseja que o resultado final seja semelhante ao abaixo, sem linhas entre os 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

também presumirei que seus dados começam na célula A1 e que cada nome é único. caso contrário, a macro precisará de alguns pequenos ajustes. definido Stopper = 50000para a linha após o seu último conjunto de dados, caso contrário, isso poderá durar 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

informação relacionada