☰

Использование инструмента «Транспонировать» в Excel для большого столбца значений

tag-icon • tag-icon microsoft-excel vba
Использование инструмента «Транспонировать» в Excel для большого столбца значений

У меня есть очень большой рабочий лист с данными имен и адресов. Сейчас он выглядит примерно так:

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

Существуют сотни и сотни таких групп, все они разделены как минимум одной пустой строкой. Теперь я могу использовать инструмент транспонирования вручную, но это займет у меня довольно много времени. Я думал просто написать макрос, чтобы сделать это, однако некоторые адреса состоят из трех строк, а некоторые из четырех, поэтому меня сбивает с толку, возможно ли это вообще.

Есть ли простые способы сделать это, не делая все вручную?

решение1

Теперь я предполагаю, что вы хотите, чтобы конечный результат выглядел примерно так, как показано ниже, без линий между людьми и с полным адресом в одной строке в одной ячейке.

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

Я также предполагаю, что ваши данные начинаются в ячейке A1 и что каждое имя уникально. Если это не так, то макрос потребует незначительной настройки. Установите его Stopper = 50000на строку после вашего последнего набора данных, в противном случае это может продолжаться гораздо дольше, чем необходимо (или, возможно, недостаточно долго).

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

Связанный контент