二つのリストから店舗別リストを作成

質問

お世話になっております。

出来ればマクロで在庫リスト、売上リストから店舗別のリストを作成したいのですが店舗リストに纏めるときに在庫リストで売上リストに同じ品目が無い時に空白が出来てしまい上手く揃えることが出来ません。
ご教授お願い致します。

在庫リスト 売上リスト
品目　　鹿児島　　福岡　　　　　　　　　　　品目　　鹿児島　　福岡
メロン　　　１　　　 ２　　　　　　　　　　　　　 いちご　　　１　　　 ２
みかん　　 ３　　　 １　　　　　　　　　 　　　りんご　　 　１　　　 １
りんご 　　　１　　　 １　　　　　　　　　 　　　　なし　　　　 １　　　 １　
なし　　　　　１　　　 １　　　　　　　　　 　　　みかん 　　 ３　　　 １
いちご 　　　１　　　 １　　　　　　　　　　　　 パイン　　　　１　　　 ２

これらのリストを下記のように作成したいのです。
鹿児島 　　福岡
品目　　 売上　　 在庫　　　　　　　　　　　品目　　 売上　　 在庫
いちご　　　１　　　 １　　　　　　　　　　　　 いちご　　１　　　 ２　　　　　　　
なし 　　　　１　　　 １　　　　　　　　　　　 　なし　　　　１　　　 １　
パイン 　　　１　　　 ０　　　　　　　　　　　　 パイン　　２　　　 １
みかん　　　　３　　　 ３　　　　　　　　　　　 みかん　　１　　　 １
メロン　　　　　１　　　 ０　　　　　　　　　　　 メロン　　　０　　　 ２
りんご 　　　　１　　　 １　　　　　　　　　　　　 りんご　　１　　　 １

自分でマクロを作成してみて品目の順は並び替えを使用すれば問題ないのですが、二つのリストにそれぞれ無い品目があったりなかったりする時に無いほうに追加したりして揃える事がどうしても出来ませんでした。
宜しくお願い致します。

回答No.4

hige_082 · ベストアンサー

う～ん、とってもマクロにし難い表です
人が見やすい表はデータとしては扱い難いものです
力技でやってはみましたが
品目数が変化する分には関係ありませんが
店舗数が変化すると手に負えないと思いますよ
表の構成をもう少し考えた方が良いと思います

Sub test()
Dim 在庫リスト
Dim 売上リスト
Dim i, j
With Worksheets("sheet1")
在庫リスト = .Range("a3").Resize(.Range("a1").CurrentRegion.Rows.Count - 2, 3)
売上リスト = .Range("e3").Resize(.Range("e1").CurrentRegion.Rows.Count - 2, 3)
End With
With Worksheets("sheet2")
If Range("a1").Value = "" Then
.Range("a1").Value = "鹿児島"
.Range("a2:c2").Value = Array("品目", "売上", "在庫")
.Range("e1").Value = "福岡"
.Range("e2:g2").Value = Array("品目", "売上", "在庫")
End If
.Range("a3").Resize(UBound(在庫リスト), 1) = 在庫リスト
For i = 1 To UBound(売上リスト)
For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(j, 1).Value = 売上リスト(i, 1) Then Exit For
Next j
If j > .Cells(Rows.Count, 1).End(xlUp).Row Then .Cells(j, 1).Value = 売上リスト(i, 1)
Next i
.Range("a3", .Cells(Rows.Count, 1).End(xlUp)).Copy .Range("e3")
For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To UBound(売上リスト)
If .Cells(j, 1).Value = 売上リスト(i, 1) Then
.Cells(j, 2).Value = 売上リスト(i, 2)
.Cells(j, 6).Value = 売上リスト(i, 3)
Exit For
End If
Next i
If i > UBound(売上リスト) Then
.Cells(j, 2).Value = 0
.Cells(j, 6).Value = 0
End If
Next j
For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To UBound(在庫リスト)
If .Cells(j, 1).Value = 在庫リスト(i, 1) Then
.Cells(j, 3).Value = 在庫リスト(i, 2)
.Cells(j, 7).Value = 在庫リスト(i, 3)
Exit For
End If
Next i
If i > UBound(在庫リスト) Then
.Cells(j, 3).Value = 0
.Cells(j, 7).Value = 0
End If
Next j
End With
End Sub

参考まで

お礼

お礼が遅くなり申し訳ありませんでした。

やはり元データに問題があるのですね・・・詳しく詳細を載せたいのですが
立場上全て記載するわけにはいかないので・・・
それでもマクロを作成して頂いてありがとうございます。
元データを何とかするように改善してみます。

本当にお世話をかけました。

回答No.3

ToOrisugaru

通りすがると申します。
在庫リストにコードが存在してないとなると、品目でヒットさせるしかないですね。
あまりよろしいやり方ではないのですが、上表の二つを品目でソートして、品目
をキーとしてマッチングさせる。

若しくは、出力をいったんワークテーブルに格納して品目をキーとして格納していく

　ワークテーブルは、こんな感じで作っておきます。

　　項目（品目、地域、　売上、在庫）

でもって、在庫リストと売上リストを全件読み込み、上記テーブルへ格納していく。
格納する際、地域と品目をキーとして同じものがすでに存在していたら、対象の
項目を更新する。存在しなかったら、追加する。
イメージとしては、こんな感じでできてくると思います。
＜在庫リストから＞
　品目－－－地域－－売上－－在庫
　メロン－－鹿児島－－０－－－１
　メロン－－福岡－－－０－－－２
　みかん－－鹿児島－－０－－－３
　みかん－－福岡－－－０－－－１
　リンゴ－－鹿児島－－０－－－１
　リンゴ－－福岡－－－０－－－１
　なし－－－鹿児島－－０－－－１
　なし－－－福岡－－－０－－－１
　いちご－－鹿児島－－０－－－１
　いちご－－福岡－－－０－－－１
　・在庫リストには、売上がないので、売上には０を設定

＜上記表＋売上リストから＞
　品目－－－地域－－売上－－在庫
　メロン－－鹿児島－－０－－－１
　メロン－－福岡－－－０－－－２
　みかん－－鹿児島－－３－－－３
　みかん－－福岡－－－１－－－１
　リンゴ－－鹿児島－－１－－－１
　リンゴ－－福岡－－－１－－－１
　なし－－－鹿児島－－１－－－１
　なし－－－福岡－－－１－－－１
　いちご－－鹿児島－－１－－－１
　いちご－－福岡－－－２－－－１
　パイン－－鹿児島－－１－－－０
　パイン－－福岡－－－２－－－０

・最後のパインは、売上のみ存在なので、在庫には０を設定

　＜表中の”－”は、桁合わせのための投入です＞

全てのレコードを処理し終えたら、＜上記表＋売上リストから＞が出来上がる。
＜上記表＋売上リストから＞を地域＋品目でソートすると下表のように
なります。

　品目－－－地域－－売上－－在庫
　メロン－－鹿児島－－０－－－１
　みかん－－鹿児島－－３－－－３
　リンゴ－－鹿児島－－１－－－１
　なし－－－鹿児島－－１－－－１
　いちご－－鹿児島－－１－－－１
　パイン－－鹿児島－－１－－－０
　メロン－－福岡－－－０－－－２
　みかん－－福岡－－－１－－－１
　リンゴ－－福岡－－－１－－－１
　なし－－－福岡－－－１－－－１
　いちご－－福岡－－－２－－－１
　パイン－－福岡－－－２－－－０

上記イメージから、目的の表が作成できるかと思います。

お礼

回答有難うございます。

こういうやり方があったのは思いつきませんでした。
参考になります。マクロで上手く行きませんでしたらこの方法を試したいと思います。

回答No.2

nattocurry

作成してみたコードを提示しましょう。

お礼

申し訳ありません。
標記ミスがありました。

Sub チェック()
Dim i As Long

For i = 1 To 50
If Cells(i, 1) = "" Then Exit For

Select Case Cells(i, 1)
Case Is < Cells(i, 5)
Cells(i, 5).Insert shift:=xlDown　←修正(i,※6→5)
Case Is > Cells(i, 5)
Cells(i, 1).Insert shift:=xlDown
End Select
Next
End Sub

補足

Sub チェック()
Dim i As Long

For i = 1 To 50
If Cells(i, 1) = "" Then Exit For

Select Case Cells(i, 1)
Case Is < Cells(i, 5)
Cells(i, 6).Insert shift:=xlDown
Case Is > Cells(i, 5)
Cells(i, 1).Insert shift:=xlDown
End Select
Next
End Sub

こんな感じです。
2つのリストがシートに一緒にあるものとしてその間に1列空けています。
品目だけ揃えてくれるのですが値がそのままで動いてくれません。
Cells(i, 1)の1を複数指定するにはどのような指定をしたら良いのかわかりませんでした。

回答No.1

ToOrisugaru

はじめまして、通りすがりと申します。
上記件なのですが、上表の品目には、品目コードというものは存在しないのでしょうか？
普通上記のような場合には、品目コード（上表二つとも）でソート（昇順）した表をもとに
マッチングして下表を作成するという流れになります。

補足

品目コードは売上リストには存在しておりますが、
在庫コードには存在していないのです。

その為に条件分岐が私のスキルでは思うように上手く行かなくて
困っています。

回答有難うございました。