[[20151216141646]] 『縦に並んだデータを品名ごとに横に列記したい』(link) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

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

エクセルど素人です。

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

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

  A   B     C   
1 001564 パン   イースト
2 045687 クッキー 小麦粉
3 045687 クッキー 卵
4 045687 クッキー 砂糖
5 078965 プリン  牛乳
6 078965 プリン  卵
・  ・   ・    ・
・  ・   ・    ・
・  ・   ・    ・

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

  A   B    C   D E  ・・・・
1 001564 パン   イースト
2 045687 クッキー 小麦粉 卵 砂糖
3 078965 プリン  牛乳 卵

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

自分の表はA列のコードが参考ページのように「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

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.