☰

Usando la herramienta Transponer en Excel para una gran columna de valores

tag-icon • tag-icon microsoft-excel vba
Usando la herramienta Transponer en Excel para una gran columna de valores

Lo que tengo es una hoja de trabajo muy grande con datos de nombres y direcciones. En este momento, se parece a:

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

Hay cientos y cientos de grupos como este, todos separados por al menos una fila en blanco. Ahora puedo usar la herramienta de transposición manualmente, pero esto me llevaría bastante tiempo. Pensé en simplemente escribir una macro para hacerlo, sin embargo, algunas direcciones tienen tres líneas mientras que otras tienen cuatro líneas, por lo que me confunde si eso es posible.

¿Alguna forma sencilla de hacer esto sin tener que hacerlo todo a mano?

Respuesta1

Ahora, supongo que desea que el resultado final sea similar al siguiente, sin líneas entre las personas y la dirección completa en una línea en una celda.

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

También voy a asumir que sus datos comienzan en la celda A1 y que cada nombre es único. si no es así, la macro necesitará algunos ajustes menores. configúrelo Stopper = 50000en la fila después de su último conjunto de datos; de lo contrario, esto podría durar mucho más de lo necesario (o quizás no lo 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

información relacionada