同じ品番ごとに右隣りのセルをコピー 行列を入替えて貼り付け

Question

A列に重複する品番があり
B列にA列に品番に対する紐づくコードがあります
A列の重複する同じ品番ごとにB列の紐づくコードを
コピーし、行列を入替えてA列の品番の隣の列へ
行列を入替えて貼り付けをした表を作成したいのですが
構文が全くできません。

A列　　　B列
A 123
A 456
A 789
B qqq
B eee
B uuu
B ppp
C 123
C 456
C kkk
D nnn
D zzz
上記の一覧を下記の一覧へ別シートに編集

A列　　　B列　　　C列　　D列　　　E列
A 123 456 789
B qqq eee uuu ppp
C 123 456
D kkk nnn zzz

施行錯誤しましたが構文も出来ず、こちらへ質問させて頂きました。
このような事がvbaで可能でしょうか。
ご教授頂ければ、幸いです。

Answer 1

品番の重複排除、品番に紐づくコードの検索ということなので、Dictionaryオブジェクト（連想配列）と相性のいい要件だと思います。

Sub データ変換()
    Dim Tbl() As Variant    'Sheet1の表データを配列に角納
    Tbl() = Worksheets("Sheet1").Range("A1").CurrentRegion.Value

    Dim Dic As Object   '連想配列 Keyに品番、Itemにコードのリストを角納
    Set Dic = CreateObject("Scripting.Dictionary")
    Dim i As Long
    For i = 1 To UBound(Tbl)
        If Dic.exists(Tbl(i, 1)) Then
            Dic.Item(Tbl(i, 1)) = Dic.Item(Tbl(i, 1)) & "," & Tbl(i, 2)
        Else
            Dic(Tbl(i, 1)) = Tbl(i, 2)
        End If
    Next
    
    Dim rng As Range
    Set rng = Worksheets("Sheet2").Range("A1") 'コピー先の先頭セル
    
    Dim v, a
    For Each v In Dic
        rng.Value = v '品番を代入
        a = Split(Dic.Item(v), ",") 'コードリストを配列に変換
        rng.Offset(, 1).Resize(1, UBound(a) + 1).Value = a 'コードを代入
        Set rng = rng.Offset(1) '次行に移動
    Next
End Sub

Comments

[tomochan24]

ありがとうございます。
VBAの初心者で勉強不足を痛感されられました。
ご丁寧な回答ありがとうございませす。
連想配列も知りませんでしたが、自分で頂いた回答のような構文が書けるよう。
勉強いたします。

Answer 2

それほど難しい処理ではないと思います。
元のシートをA、転記用のシートをBとして書きます。

1. N=1
2. シートAのN行目A列を取得
3. シートBのA列にあるか検索
4. あればその行の右端にシートAのN行目B列をコピー
5. なければ最終行にシートAのN行目A列とB列をコピー
6. NをインクリメントしてシートAのN行目A列がなくなるまで繰り返す

文章に起こせばたいしたことがない処理なのはわかると思います。
あとはそれぞれの処理が実装できるかどうかですね。

Answer 3

このような事がvbaで可能でしょうか。

可能です。似たようなことを行った実績はあります。
ただし、特定の構文で一発というわけにもいかず、あーだこーだとこねくり回す必要がありました。

「手作業でやるときの手順を思い出し、書き出してみる」というのが、迷ったときの打開策になったりします。私の場合は下記のような手順になりました。

1. 別シートを用意する。
2. 用意したシートのA列にA, B, C, Dを書き込む
3. A列を見比べつつ、対応するB列を横に並べていく。

他の（もっと良い）やり方もあるでしょう。