☰

Excel の転置ツールを使って大きな列の値を入力する

tag-icon • tag-icon microsoft-excel vba
Excel の転置ツールを使って大きな列の値を入力する

私が持っているのは、名前と住所のデータの非常に大きなワークシートです。現時点では、次のようになります。

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

このようなグループが何百もあり、すべて少なくとも 1 つの空白行で区切られています。 手動で転置ツールを使用することもできますが、これにはかなりの時間がかかります。 マクロを書いてこれを行うことも考えましたが、アドレスの中には 3 行のものもあれば 4 行のものもあるため、それが可能かどうかわかりません。

すべてを手作業で行うことなく、これを行う簡単な方法はありますか?

答え1

さて、最終結果は、個人間に線がなく、1つのセルに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

関連情報