EXCEL2010 抽出とドロップダウンリスト

質問

windows7
Excel2010 です。

ファイル名：物件データ一覧
ワークシート名：物件一覧

に

　　　　　　A　　　　　　　　　　　　B　　　　　　　　　　　　C
1 　　担当者　　　　　　　　物件名　　　　　　　　　納入品名　
2　　　鈴木　一郎　　　　　　ＡＢＣ商事　　　　　　　　いろは
3　　　鈴木　一郎　　　　　　ZZZ商会A　　　　　　　　にほへ
4　　　鈴木　一郎　　　　　　BB商事　　　　　　　　　 にほへ
5

というようなデータが保存されており、

ファイル名：明細書作成
ワークシート名：3月分

という別ファイルで作業を行います。

A1セルにAと入力(全角半角は区別しない）すると
B1セルにドロップダウンリストでＡＢＣ商事とZZZ商会Aが表示され、
ＡＢＣ商事を選択すると
C1セルにいろはが自動で表示されるようにしたいのです。

どなたか教えていただけませんでしょうか？
宜しくお願い致します。

回答No.1

bunjii · ベストアンサー

>A1セルにAと入力(全角半角は区別しない）すると
>B1セルにドロップダウンリストでＡＢＣ商事とZZZ商会Aが表示され、
作業用の列を使ってデータの入力規則用テーブルを作成すれば可能かと思います。

>ＡＢＣ商事を選択すると
>C1セルにいろはが自動で表示されるようにしたいのです。
B1セルの値を使って物件一覧シートのB列とC列からVLOOKUP関数でピックアップできるはずです。

其々の数式は以下のようにされると良いでしょう。

明細書作成の3月分シートに作成する入力規則テーブル用数式
=IFERROR(INDEX(物件一覧!B$1:B$400,SMALL(NOT(ISERROR(FIND(ASC(B$1),ASC(物件一覧!B$1:B$400))))*ROW(B$1:B$400)+(ISERROR(FIND(ASC(B$1),ASC(物件一覧!B$1:B$400))))*1000,ROW())),"")
この式は配列値を扱いますので数式バーに入力後、Ctrl+Shift+Enterで確定してください。
必要数を下へオートフィルでコピーします。

C列には次の式で良いでしょう。
=IF(B1="","",VLOOKUP(B1,物件一覧!B$1:C$400,2,FALSE))
必要数を下へオートフィルでコピーします。

当方ではデータの最大行を400としましたので必要に応じて最大行を変更してください。

お礼

まず、お礼が大変遅くなりましたことお詫び申し上げます。
ぜひ、こちらの方法で挑戦したいと思います。
ご回答ありがとうございました。

回答No.2

tom04

こんばんは！
一例です。

VBAで「物件データ一覧」ファイルの「3月分」Sheetにオートフィルタをかけ　
「明細書作成」ファイルの「Sheet2」に表示させ、それを入力規則の「リスト」の元のデータとしています。
すなわち、「明細書作成」BookのSheet2は使っていない状態にしておいてください。

まず、「明細書作成」Bookを開き　Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール
→　VBE画面（カーソルが点滅しているところ）に↓のコードをコピー＆ペーストしてみてください。

Sub 抽出() 'この行から
Dim wB As Workbook, wS As Worksheet, wS1 As Worksheet, wS2 As Worksheet
Dim myPath As String, fName As String
Dim lastRow As Long, myFlg As Boolean
myPath = "C:\Users\「PC名」\Documents\「フォルダ名」\"）
'詳しくは保存場所のExcelファイルのアイコン上で右クリック　→　プロパティで確認
fName = "物件データ一覧.xlsx"
For Each wB In Workbooks
If wB.Name = fName Then
myFlg = True
End If
Next wB
If myFlg = False Then
Set wB = Workbooks.Open(myPath & fName)
Else
Set wB = Workbooks(fName)
End If
Set wS = wB.Worksheets("3月分")
Set wS1 = ActiveSheet
Set wS2 = Worksheets("Sheet2")
With wS
.Range("A1").AutoFilter field:=2, Criteria1:="*" & StrConv(Range("A1"), vbNarrow) & "*", _
Operator:=xlOr, Criteria2:="*" & StrConv(Range("A1"), vbWide) & "*"
End With
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
With wS2
.Range("A:A").ClearContents
If lastRow > 2 Then
Range(wS.Cells(2, "B"), wS.Cells(lastRow, "B")).SpecialCells(xlCellTypeVisible).Copy wS2.Range("A1")
End If
End With
wS1.Select
wS.AutoFilterMode = False
End Sub 'この行まで

次に「明細書作成」Bookの画面左下にあるSheet見出しの「3月分」上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペースト　→　Excel画面に戻ってください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
If Target.Address = "$A$1" Then
Range("B1").ClearContents
Call 抽出
End If
End Sub 'この行まで

最後の「3月分」SheetのB1セルを選択　→　データ　→　データの入力規則　→　リスト　→　元の値の欄に
=OFFSET(Sheet2!A1,0,,COUNTA(Sheet2!A:A))
という数式を入れOK

これでA1セルにデータを入力してみてください。
B1セルにはA1セルを含むデータのみが入力規則のリスト候補になっていると思います。

最後にc1セルに
=IF(B1="","",VLOOKUP(B1,'[物件データ一覧.xlsx]3月分'!$B:$C,2,0))
という数式を入れて完了です。m(_ _)m

お礼

まず、お礼が大変遅くなり申し訳ございません。
ちょっとこちらは私には難しそうです。
ちょっとしたマクロを組んで実行してみたら、無反応で。。。そこからしてつまずいていて、ここまでいくにはかなり時間かかりそうです。
クリアできてから、参考にさせていただきたいと思います。
ありがとうございました。