☰

Verwenden des Transponierungstools in Excel für eine große Wertespalte

tag-icon • tag-icon microsoft-excel vba
Verwenden des Transponierungstools in Excel für eine große Wertespalte

Ich habe ein sehr großes Arbeitsblatt mit Daten zu Namen und Adressen. Im Moment sieht es ungefähr so ​​aus:

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

Es gibt Hunderte und Aberhunderte solcher Gruppen, die alle durch mindestens eine leere Zeile getrennt sind. Ich kann das Transponierungstool zwar manuell verwenden, aber das würde ziemlich viel Zeit in Anspruch nehmen. Ich habe darüber nachgedacht, einfach ein Makro dafür zu schreiben, aber manche Adressen sind dreizeilig, während andere vierzeilig sind, sodass ich mir nicht sicher bin, ob das überhaupt möglich ist.

Gibt es einfache Möglichkeiten, dies zu tun, ohne alles von Hand machen zu müssen?

Antwort1

Ich gehe davon aus, dass Sie möchten, dass das Endergebnis ungefähr wie das folgende aussieht, ohne Linien zwischen den einzelnen Personen und mit der vollständigen Adresse in einer Zeile in einer Zelle.

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

ich gehe außerdem davon aus, dass Ihre Daten in Zelle A1 beginnen und jeder Name eindeutig ist. Ist dies nicht der Fall, muss das Makro geringfügig angepasst werden. Stellen Sie es Stopper = 50000auf die Zeile nach Ihrem letzten Datensatz ein, da dies sonst möglicherweise viel länger dauert als nötig (oder vielleicht nicht lange genug).

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

verwandte Informationen