エクセル表から項目と交点データを抽出する

質問

表1
品番 　　　出荷日
製品A 　　10/1
　　　 　　台数
　　　　　　　5

表２
品番 10/1 10/2 10/3 10/4
製品A　5 　　5 　　5 　　0
製品B　0 　　0 　　0 　　5
製品C　0 　　0 　　2 　　0
製品D　0 　　1 　　0 　　3

表2のように製品名と納入日、その交点に納入数が表記されています。
製品Aを10/1に納入する　5　が表記されたセルをクリックすると表1のようにデータが抽出する事が出来るでしょうか？
現状は製品名は入力規制でプルダウンメニューからクリック選択、日付はカレンダーコントロールの日付をクリック選択、台数はINDEX,MATCH関数でデータ抽出して表1を作成しています。

回答No.1

tom04 · ベストアンサー

こんにちは！

＞5　が表記されたセルをクリックすると・・・
とすると間違ったセルを選択した時点でマクロが入ってしまいますので、
ダブルクリックとしてみました。

↓の画像で上側が元データのSheet1、下側がSheet2として
データ範囲をダブルクリックするとSheet2のA2～C2セルに表示させるようにしています。

画面左下の操作したいSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストし、Sheet1に戻りダブルクリックしてみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, j As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
If Target.Count = 1 And Target.Row > 1 And Target.Column > 1 Then
i = Target.Row
j = Target.Column
wS.Range("A2:C2").ClearContents
With wS.Range("A2")
.Value = Cells(i, "A")
.Offset(, 1) = Cells(1, j)
.Offset(, 2) = Target
End With
wS.Range("B2").NumberFormatLocal = "m/d"
End If
End Sub

※　データ範囲が判らないので、2行目以降・B列以降のセルをダブルクリックすると
マクロが実行されるようになります。
（空白セルをダブルクリックしてもマクロが実行されます）
データ範囲が判れば最初の部分で制限してやります。m（_ _）m

お礼

本当にありがとうございました。
さっそく説明どうりにVBE画面にコピー＆ペーストして実行してみました。驚きの一言です。
実は回答していただけるかどうか分らないので少し内容を省略していたのですが、抽出した値から発注書を作成したいのです。発注書が小さいのでA4が1枚で3通の発注書ができます。その為下記の表のイメージフォームの(1).(2).(3)に別々のデータを同一シート内で抽出したいのです。製品の種類は約300あります。マクロの知識がありませんので回答頂いた内容の修正する事ができません。よろしくお願いいたします。(すみません。表が絵として貼りつけできません）

(1)品番　出荷日 台数　(2)品番　出荷日 台数　(3)品番　出荷日 台数
　製品A 　10/2 　 5 　 製品Ｂ　 10/3 　 　8 製品C 　　10/4 　　 12

品番 10/1 10/2 10/3 10/4
製品A　0　　5　　5　　0
製品B　0　　0　　8　　5
製品C　0　　0　　2　　12
製品D　0　　1　　0　　3

回答No.2

tom04

No.1です。

＞1枚で3通の発注書ができます

とありますが、実際のレイアウトが判らないので
↓の画像のようになっているという前提のコードになります。

「発注書」となると複数行必要だと思いますので、
余計なお世話かもしれませんが、横3項目がいっぱいになれば次の行へ！
といった感じのコードにしています。

前回のコードは削除して↓のコードに変更し、Sheet1のデータをダブルクリックしてみてください。
尚、Sheet2の「日付」列の表示形式は手動で変更しておいてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'この行から
Dim i As Long, j As Long, endRow As Long, wS2 As Worksheet
Set wS2 = Worksheets("Sheet2")
If Target.Row > 1 And Target.Column > 1 Then
Cancel = True
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountA(wS2.Rows(endRow)) = 0 Or _
WorksheetFunction.CountA(wS2.Rows(endRow)) = 9 Then
i = endRow + 1
j = 1
Else
i = endRow
j = wS2.Cells(endRow, Columns.Count).End(xlToLeft).Column + 1
End If
With wS2.Cells(i, j)
.Value = Cells(Target.Row, "A")
.Offset(, 1) = Cells(1, Target.Column)
.Offset(, 2) = Target
End With
End If
End Sub 'この行まで

※　マクロの場合1行・1列違っただけでもめちゃくちゃな動きになりますので、
Sheet2の配置が違う場合はコード変更する必要があります。m（_ _）m

お礼

どうもありがとうございました。
当初は、印刷用データを発注書1部分を作成し、印刷した後次のデータを作成と考えていたのですが、印刷用データを全て作成することができ、後は印刷が一気にすることができて、想定していたものよりかなり便利なものができそうです。発注書フォームを作成するに当たりわからない点を質問させて頂く事があるかもしれませんが、その時はまたよろしくおねがいします。