[[20151216141646]]　『縦に並んだデータを品名ごとに横に列記したい』（link）　ページの最後に飛ぶ

『縦に並んだデータを品名ごとに横に列記したい』（link）

エクセルど素人です。

アドバイスお願いします。

vlookup検索範囲用のデータ作成のために、値を横に並べたシートを作成したいです。
具体的には、下記のような表を。。。

　　Ａ　　　Ｂ　　　Ｃ　　　
１　001564　パン　　　イースト
２　045687　クッキー　小麦粉
３　045687　クッキー　卵
４　045687　クッキー　砂糖
５　078965　プリン　　牛乳
６　078965　プリン　　卵
・　　・　　　・　　　　・
・　　・　　　・　　　　・
・　　・　　　・　　　　・

このように並び替えたいです。

　　Ａ　　　Ｂ　　Ｃ　ＤＥ　　・・・・
１　001564　パン　　　イースト
２　045687　クッキー小麦粉卵砂糖
３　078965　プリン　　牛乳卵

似たような質問がないか検索し、このサイトの
https://www.excel.studio-kazu.jp/kw/20080213140737.html
を参考にはしてみたのですが、

自分の表はＡ列のコードが参考ページのように「1,2,3」など連番ではないので、
うまく解決できませんでした。

どうぞよろしくお願いします。。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 こういうこと？
 Sub test()
    Dim a, i As Long, ii As Long, w, ub As Long
    With Cells(1).CurrentRegion
        a = .Value: ub = UBound(a, 2)
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    ReDim w(1 To 3)
                    Set w(1) = CreateObject("Scripting.Dictionary")
                    w(2) = .Count + 1: w(3) = 1: a(w(2), 1) = a(i, 1)
                    .Item(a(i, 1)) = w
                End If
                w = .Item(a(i, 1))
                For ii = 2 To ub
                    If Not w(1).exists(a(i, ii)) Then
                        w(3) = w(3) + 1: w(1)(a(i, ii)) = Empty
                        If UBound(a, 2) < w(3) Then
                            ReDim Preserve a(1 To UBound(a, 1), 1 To w(3))
                        End If
                        a(w(2), w(3)) = a(i, ii)
                    End If
                Next
                .Item(a(i, 1)) = w
            Next
            i = .Count
        End With
        .Offset(, .Columns.Count + 2).Resize(i, UBound(a, 2)).Value = a
    End With
End Sub

（seiya） 2015/12/16(水) 15:10

 よく読むと単純にこっちの方だね

 Sub test()
    Dim a, i As Long, ii As Long, txt As String
    With Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .exists(txt) Then
                    ReDim w(1 To 2)
                    w(1) = .Count + 1: w(2) = 2
                    For ii = 1 To 2
                        a(w(1), ii) = a(i, ii)
                    Next
                    .Item(txt) = w
                End If
                w = .Item(txt): w(2) = w(2) + 1
                If UBound(a, 2) < w(2) Then ReDim Preserve a(1 To UBound(a, 1), 1 To w(2))
                a(w(1), w(2)) = a(i, 3)
                .Item(txt) = w
            Next
            i = .Count
        End With
        .Offset(, .Columns.Count + 2).Resize(i, UBound(a, 2)).Value = a
    End With
End Sub
（seiya） 2015/12/16(水) 15:22

コメント返信：

[ 一覧(最新更新順) ]

[[20151216141646]] 『縦に並んだデータを品名ごとに横に列記したい』（link） ページの最後に飛ぶ

[[20151216141646]]　『縦に並んだデータを品名ごとに横に列記したい』（link）　ページの最後に飛ぶ