エクセルVBAでの複数検索システムについて（図面管理）

質問

質問させて頂きます。

現在会社で図面をスキャンして登録する事で
品番から検索できるシステムをエクセルVBAで作って運用しているのですが
「品番」だけではなく「相手先会社名」で絞り込んだ上で
品番検索できるシステムに変更したいと思っています。

品番　 品名　相手先会社名　備考
135A1 あいう　佐藤株式会社
274B2 かきく　中野製作所
355F4 さしす　佐藤株式会社
659A2 たちつ　伊藤工業
788B2 なにぬ　伊藤工業
821A3 はひふ　田中プレス
903B2 まみむ　中野製作所

登録情報は上記のようなもので、登録数は約１０００枚分です。
現在は専用フォームを立ち上げ、
品番部分の昇順をコンボボックス内で表示させて選択する事で
該当の情報を表示しています。

これをそのままに、相手先会社名の部分もコンボボックスにして
相手先会社名を選択した場合、その会社名のものだけを品番コンボボックスで表示させて
絞り込んだ状態で品番を選択できるようにしたいと思ってます。

このようなものを作る時に
情報元には当然同じ会社名のものが複数あるわけですが
それら重複するものを１つとして表示させ
かつ、その会社名を選択するとその会社名のもの全てを
品番のコンボボックス内に表示させ、選択できるようにしたいのですが
どうしたら良いのでしょうか。

大雑把な質問内容で恐縮ですが
ご存じな方おられましたら教えて頂けますようお願いします。

回答No.2

hotosys

作業シートを使う方法です。
ユーザーフォームにはComboBox1(社名用)とComboBox2(品名用)があるとします。
ユーザーフォームのモジュール部に以下をコピーしてみてください。
Const dataSheetName = "Sheet1" '元データシート名
Const tempSheetName = "Sheet2" '作業シート名
'初期設定（ComboBox1に表示する社名リスト作成）
Private Sub UserForm_Activate()
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Set dataSheet = Sheets(dataSheetName)
Set tempSheet = Sheets(tempSheetName)
'作業シートクリア
tempSheet.Cells.Clear
'相手先会社名を重複を削除して作業シートのA列へコピー
dataSheet.Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=tempSheet.Range("A1"), Unique:=True
'並べ替え
tempSheet.Range("A:A").Sort Key1:=tempSheet.Range("A2"), Order1:=xlAscending, Header:=xlYes
'コンボボックスのRowSourceを設定
ComboBox1.RowSource = tempSheet.Name & "!A2:A" & tempSheet.Range("A" & tempSheet.Rows.Count).End(xlUp).Row
End Sub
'ComboBox1を選択した場合にComboBox2の品番リスト作成
Private Sub ComboBox1_Change()
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Set dataSheet = Sheets(dataSheetName)
Set tempSheet = Sheets(tempSheetName)
'現在のコンボボックスのデータクリア
ComboBox2.Value = ""
'フィルタ用データ作成
tempSheet.Range("B1") = dataSheet.Range("C1") '見出しコピー
tempSheet.Range("B2") = ComboBox1.Value
'条件にあった品名を作業シートのC列へコピー（余計なデータもコピーされる)
dataSheet.Columns("A:C").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=tempSheet.Range("B1:B2"), CopyToRange:=tempSheet.Range("C1")
'並べ替え
tempSheet.Range("C:C").Sort Key1:=tempSheet.Range("C2"), Order1:=xlAscending, Header:=xlYes
'コンボボックスのRowSourceを設定
ComboBox2.RowSource = tempSheet.Name & "!C2:C" & tempSheet.Range("C" & tempSheet.Rows.Count).End(xlUp).Row
End Sub

回答No.1

imogasi

>１０００枚分
突然「枚」とはなに？エクセルのシートで１０００行？
ーー
質問者は、色々書くけど、品名＝品番対応か品名＝多数品名だろうから品番と会社名を問題にすればよいのでしょう。
多分会社名は重複出現するのだろうが、品番も重複出現するのですか？
データを扱うときこれらを明示しないのは、不十分。
ーー
２条件で抜き出して、さらにその中から、人間による第3の選択が必要なのか？
ーーー
関数で２条件抜きだしという質問もこのコーナーで多い。
ＶＢＡでは検索は（１）フィルタや（２）Ｆｉｎｄメソッドしかなく、（３）１０００行総当り検索は苦しいかな。
（２）Ｆｉｎｄメソッドはまず品番でしか検索出来ず、見つかった行で、さらに会社列が指定会社名か判別し、一致しなければ捨てて、一致するものだけを表示するようにすれば出来る。
FindメソッドはＧｏｏｇｌｅででも「ＶＢＡ　Ｆｉｎｄ」で照会すれば、コード例が沢山出るでしょう。しかしＦｉｎｄＮｅｘｔとの組み合わせと見つからないときの捉え方、ヒットの終わりなど、初心者には難しいと思う。
ーーー
（１）（２）ともテキストボックス２つで、品番と会社名を指定（手入力）すると十分だが、これらもコンボでの選択が必要か？
ーーー
（１）のフィルター
こんなのはマクロの記録で出来る。「ＶＢＡで」と言ってながら、それさえも検討したと質問に報告も無い。操作は「フィルタオプションの設定」に当たる。
まるきり丸投げでは。
ーー
下記を参考に。
例データ　Ａ１：Ｄ９
品番 品名 相手先会社名 備考
135A1 あいう 佐藤株式会社
274B2 かきく 中野製作所
355F4 さしす 佐藤株式会社
659A2 たちつ 伊藤工業
788B2 なにぬ 伊藤工業
821A3 はひふ 田中プレス
903B2 まみむ 中野製作所
355G3 さしす 佐藤株式会社
ーー
条件セル範囲
Ｇ１：Ｈ２
品番 相手先会社名
355F4 佐藤株式会社
ーー
コード（マクロの記録）
Sub Macro1()
Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"G1:H2"), CopyToRange:=Range("J1:M9"), Unique:=True
End Sub
実行結果
品番 品名 相手先会社名 備考
355F4 さしす 佐藤株式会社
「重複するレコードは無視する」にしているので、２行同じものがあっても、１行しか表示されない。
ーー
Ｄ９は最終行だが、一般化して、この出し方（コード）などわかるよね。
条件セル（Ｇ１：Ｈ２）は、この操作が、エクセルの機能なので、シート上に置かないと仕方がない。
結果を第3のコンボなどのアイテムに設定したい場合は、一旦シートのセル範囲に出てしまうので、上記Ｊ－Ｍ列のデータをＲｏｗＳｏｕｒｃｅプロパティで設定するか、セルを読み取ってＡｄｄＩｔｅｍするほか仕方がない。
ーー
そろそろアクセスを利用すべきの域に入ってきたようだ。