EXCEL： データベースからの抽出

質問

すみません、初心者なのです。どなたか教えてください。
独立したデータベースのファイルを作り、別sheet上で以下のA)またはB)ような抽出を行いたいのです。どのようにすればいいでしょうか。

↓データベース
区分　　P/N　　品名
食品　　001　　りんご
食品　　008　　ぶどう
衣類　　022　　帽子
食器　　033　　茶碗
衣類　　024　　くつ下

↓別sheet
区分　　P/N　　品名
食品　　001　　りんご

A) 「区分」のリストから「食品」を選ぶ→「品名」に「食品」のみのリストが表示でき、そこから任意の品名を選ぶと「P/N」も自動的に入る。
B) 「P/N」に「001」と入力すると、品名「りんご」が自動的に表示される。

よろしくお願いします。

回答No.3

kazuhiko5681 · ベストアンサー

こんばんわ。マクロの記述ミスです、修正マクロを組んでみました。次のように操作してみて下さい。

・データの入力されているブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を表示させ、画面左上のVBAProjectと書かれている下のSheet1をダブルクリックして表示された画面の右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRow As Integer

myRow = Target.Row

Application.EnableEvents = False
If Target.Address = Cells(myRow, 1).Address Then
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(myRow, 1).Value
ElseIf Target.Address = Cells(myRow, 3).Address Then
Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = Cells(myRow, 3).Value
Worksheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(myRow, 2).Value
End If
Application.EnableEvents = True

End Sub

・画面左上のVBAProjectと書かれている下のSheet2をダブルクリックして表示された画面の右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRow As Integer
Dim myRange As Range
Dim myCell As String
Dim myKodo As String

myRow = Target.Row
If Target.Address <> Cells(myRow, 2).Address Then Exit Sub
If Target.Value = "" Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = "": Target.Offset(0, -1).Value = ""
Else
Application.EnableEvents = False
myCell = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Address
myKodo = Cells(myRow, 2).Value
Set myRange = Worksheets(1).Range("B1:" & myCell).Find(myKodo, LookAt:=xlWhole)
If myRange Is Nothing Then
MsgBox "入力されたコードは、ありません。"
Else
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = myRange.Offset(0, -1).Value
Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = myRange.Offset(0, 1).Value
End If
End If
Application.EnableEvents = True

End Sub

データベースとなる表をシート１選択したものを表示する表をシート２としてマクロを組んであります。

操作方法１
１.シート１の区分欄から適当な項目のセルを選択する。
２.シート１の品名欄から適当な項目のセルを選択する。
シート２に選択された区分・品名・それに対応するp/nが自動的に表示されます。

操作方法２
１.シート２のｐ/ｎ欄に適当な番号を入力する。
シート２に入力されたp/nに対応する区分・品名が指定の場所に自動的に表示されます。

ご不明な点・不具合等がございましたら、ご遠慮なくお知らせ下さい。貴方様の思い通りの動作ができるようになるまで、ご一緒に考えていきたいと思います。

お礼

スラリと実行されました！
すばらしい。感激
ほんとにどうもありがとうございました。

回答No.2

kazuhiko5681

初めまして。ＶＢＡでサンプルマクロを作ってみました。下のコードをコピー＆ペーストするだけで、貴方様の思い通りの動作をします。次のように操作してみて下さい。

・データの入力されているブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を表示させ、画面左上のVBAProjectと書かれている下のSheet1をダブルクリックして表示された画面の右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myRow As Integer

myRow = Target.Row

If Target.Address = Cells(myRow, 1).Address Then
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(myRow, 1).Value
ElseIf Target.Address = Cells(myRow, 3).Address Then
Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = Cells(myRow, 3).Value
Worksheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(myRow, 2).Value
End If

End Sub

・画面左上のVBAProjectと書かれている下のSheet2をダブルクリックして表示された画面の右側の白い部分に下記のコードをコピー＆ペーストする。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRow As Integer
Dim myRange As Range
Dim myCell As String
Dim myKodo As String

Application.EnableEvents = False
myRow = Target.Row
If Target.Address <> Cells(myRow, 2).Address Then Exit Sub
myCell = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Address
myKodo = Cells(myRow, 2).Value
Set myRange = Worksheets(1).Range("B1:" & myCell).Find(myKodo, LookAt:=xlWhole)
If myRange Is Nothing Then
MsgBox "入力されたコードは、ありません。"
Else
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = myRange.Offset(0, -1).Value
Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = myRange.Offset(0, 1).Value
End If
Application.EnableEvents = True

End Sub

データベースとなる表をシート１選択したものを表示する表をシート２としてマクロを組んであります。

操作方法１
１.シート１の区分欄から適当な項目のセルを選択する。
２.シート１の品名欄から適当な項目のセルを選択する。
シート２に選択された区分・品名・それに対応するp/nが自動的に表示されます。

操作方法２
１.シート２のｐ/ｎ欄に適当な番号を入力する。
シート２に入力されたp/nに対応する区分・品名が指定の場所に自動的に表示されます。

ご不明な点・不具合等がございましたら、ご遠慮なくお知らせ下さい。貴方様の思い通りの動作ができるようになるまで、ご一緒に考えていきたいと思います。

お礼

連絡おくれてすみません。
なんだか、すごいモノを作っていただいてありがとうございます。
ご指示通りやってみたらできました。ただ、時々うまくシート２に反映されない現象があります。いったんエクセルを終了し再び開くと実行されますが、これは私のＰＣ上の問題ということなのでしょうか？

回答No.1

oresama

データベース（シート名）、A1は区分
別sheet（シート名）、A1は区分、A2が区分入力セル
とします。

リストからの入力の設定方法の説明も割愛させていただきます。

1：データベースに検索用key追加
1-1
左端にA、Bニ列挿入
1-2
A2に=COUNTIF($C$2:C2,C2) 以下最終行までコピペ
1-3
B2に=A2&C2　以下同じ
1-4
B1に=MAX(A:A)

2：別sheetに、区分リストの作成
2-1
D列に、区分のリストを入力
2-2
E列に　1-4で求めた数だけ、1、2、・・・と入力
2-3
F列に、=E1&$A$2　以下最終行までコピー
2-4
G列に、
=IF(ISERROR(VLOOKUP(F1,データベース!$B$2:$D$6,3,0)),"",VLOOKUP(F1,データベース!$B$2:$D$6,3,0))　以下同じ

3：A2、B2、C2の設定
3-1
A2のリストから入力を、D列にする。
3-2
B2のリストから入力を、G列にする。
3-3
C2に、
=IF(ISERROR(VLOOKUP(B2,データベース!$D$2:$E$6,2,0)),"",VLOOKUP(B2,データベース!$D$2:$E$6,2,0))

いかがでしょう？

お礼

連絡おくれてすみません。
いろいろ考えていただいてホントにありがとうございました。
初心者なので、どういう仕組みになっているのか理解不能ですが、勉強しながら理解していこうと思います。
ありがとうございました。