Excelで1つの条件で複数の値を抽出するVBA

質問

製造した製品について作業を行うカレンダー予定表を作りたいのですが、
生産計画をマスターシート(Sheet1)として、作業計画(Sheet2)を
以下の画像のように、自動的に抽出する事はできますか？

私は、Excelはあまり詳しい方ではありません。
それなりに色々と調べてはみたのですが、関数では思ったような物ができず、
うまくいきませんでした。

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

回答No.2

KURUMITO · ベストアンサー

回答Ｎｏ２，３です。シート2のＢ２セルへは次の式で良かったですね。

=IF(ISERROR(INDEX(Sheet1!$A:$B,MATCH(LOOKUP(10^10,$A$2:$A2)*100+ROW(A1)-MATCH(10^10,$A$2:$A2)+1,Sheet1!$D:$D,0),COLUMN(A1))),"",INDEX(Sheet1!$A:$B,MATCH(LOOKUP(10^10,$A$2:$A2)*100+ROW(A1)-MATCH(10^10,$A$2:$A2)+1,Sheet1!$D:$D,0),COLUMN(A1)))

お礼

KURUMITOさん　お礼遅くなりましたが、早速の回答ありがとうございます。
なるほど～☆作業列の使い方、参考になります。
自分なりにアレンジして、思っていた予定表が仕上がりました！！！
今月から、作業に活かせそうです。本当に助かりました～。
ありがとうございます(^-^)

回答No.3

tom04

こんばんは！
VBAでの一例です。

前提条件として・・・
（1）画像のようにSheet2のA列は6セル毎に結合している
（同一日のデータは6以上表示しない）というコトが前提となります。
（2）同一日に生産された「製品名」「製品番号」の重複はない。
だとします。

画面左下のSheet2のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてSheet2のA列に日付データを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") '←「Sheet1」の部分は実際のSheet名に！
On Error Resume Next
If Intersect(Target, Columns(1)) Is Nothing Or _
Target = "" Then Exit Sub
Application.ScreenUpdating = False
k = Target.Row - 1
Range(Cells(k + 1, 2), Cells(k + 6, 3)).ClearContents
For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(i, 3) = Target Then
k = k + 1
With Cells(k, 2)
.Value = ws.Cells(i, 1)
.Offset(, 1) = ws.Cells(i, 2)
End With
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

参考になりますかね？m(_ _)m

お礼

tom04さん　丁寧なご回答ありがとうございます。
ただ、日付は、月初めの１日目（4/1）を入力し、以降A列の4/2,4/3,・・・は
数式で自動的に表示させるつもりでした。
B列、C列は、A列に直接入力した時しか表示されませんでした。

私は、コードの意味はよく分かりませんが、入力したところは、うまく表示され、
感動しました！！！
ありがとうございます☆

回答No.1

KURUMITO

式が複雑になりますので作業列を作って対応するのがよいでしょう。また配列数式などを使いますと計算に負担がかかります。
シート1のＤ2セルには次の式を入力して下方にドラッグコピーします。

=IF(C2="","",C2*100+COUNTIF(C$2:C2,C2))

シート2のＢ2セルには次の式を入力してＣ2セルまでドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>MATCH(10^10,$A$2:$A2)+5,"",IF(ISERROR(INDEX(Sheet1!$A:$B,MATCH(LOOKUP(10^10,$A$2:$A2)*100+ROW(A1)-MATCH(10^10,$A$2:$A2)+1,Sheet1!$D:$D,0),COLUMN(A1))),"",INDEX(Sheet1!$A:$B,MATCH(LOOKUP(10^10,$A$2:$A2)*100+ROW(A1)-MATCH(10^10,$A$2:$A2)+1,Sheet1!$D:$D,0),COLUMN(A1))))