VBAでVLOOKUPを使いデータ検索したい

皆様、毎度お世話になっております。
いまExcelでマクロを組んでおりまして、色々なサイトを見て勉強しながら作成しております。
通常、VLOOKUP関数のみで参照範囲から検索すると、条件が1つのみになってしまうのですが．．．
（本来なら条件を複数設定できるのかもしれませんが、、、何分、私が知識不足でして）

皆様のお手を煩わせて申し訳ありませんが、ご教授いただけませんでしょうか？

参照元データを「Book2.xls」、マクロを走らせるデータを「Book1.xls」とします（office2000を使用しております）

「Book2.xls」には以下の内容を入力したとします。
　 A　B　C　
1　1　a　ア　
2　2　b　イ　
3　3　c　ウ　
4　4　d　エ　
5　5　e　オ　
6　6　f 　カ　
7　・
8　・

「Book1.xls」の標準モジュールに以下のマクロを組んでいます。
'===================================================
Sub main()
　　Dim rs As Object
　　Dim sql_str As String
　　Dim retcode As Long
　　retcode = open_ado_excel(ThisWorkbook.Path & "\book2.xls")
'　　　　　　 ADOでExcelブックBook2.Xlsに接続
　　If retcode = 0 Then
　　　 f_num = Application.InputBox("input find number")
　　　 '↑　検索するナンバーを入力
　　　 If TypeName(f_num) <> "Boolean" Then
　　　　　sql_str = "select [名称] from [Sheet1$] where [NO] = " & f_num & ";"
　　　　　'ナンバーを検索するSQLの作成
　　　　　Set rs = exec_sql(sql_str, retcode) 'SQLの実行
　　　　　If retcode = 0 Then
　　　　　　 If rs.EOF <> True Then '　見つかった
　　　　　　　　MsgBox rs![名称]
　　　　　　 Else '見つからない
　　　　　　　　MsgBox "not found"
　　　　　　　　End If
　　　　　　 rs.Close
　　　　　　 Set rs = Nothing
　　　　　Else
　　　　　　 MsgBox Error$(retcode)
　　　　　　 End If
　　　　　End If
　　　 call close_ado()
　　Else
　　　 MsgBox Error(retcode)
　　　 End If
End Sub

別の標準モジュールに
'=============================================================
Public cn As Object 'コネクションオブジェクト
'=============================================================
Function open_ado_excel(book_fullname As String) As Long
'ADOでExcelブックに接続する
'in　book_fullname -- 接続するブックのフルパス
'ot　open_ado_excel-- リターンコード　0－正常　その他--エラー
　　On Error Resume Next
　　Set cn = CreateObject("ADODB.Connection")
　　link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
　　　　　　　"Data Source=" & book_fullname & ";" & _
　　　　　　　"Extended Properties=Excel 8.0;"
　　cn.Open link_opt
　　open_ado_excel = Err.Number
　　On Error GoTo 0
End Function
'=================================================
Sub close_ado()
'接続したExcelブックの切断
　　On Error Resume Next
　　cn.Close
　　Set cn = Nothing
　　On Error GoTo 0
End Sub
'=================================================
Function exec_sql(sql_str, retcode) As Variant
'SQLの実行
'in : sql_str　--- 実行するＳＱＬ
'ot : retcode ---リターンコード　0－正常　その他--エラー
'exec_sql--------ＳＱＬを実行した結果
'　　　　　　　　今回は、Recordsetオブジェクトを返す
On Error Resume Next
　　Set exec_sql = Nothing
　　Set exec_sql = cn.Execute(sql_str)
　　retcode = Err.Number
　　On Error GoTo 0
End Function

このマクロだと条件が1つのみになってしまうのです。
これを複数の条件を指定できるようにしたいのです。
（できれば、ユーザーフォームで複数条件を指定したいのですが・・・）

どのようにマクロを組めばよろしいのか、恐れ入りますがご教授ください。
なるべく早い回答をお願いします。

システムへデータを上げなければならないので・・・

私情を挟み申し訳ありませんが、何卒宜しくお願いします。

No.2 回答者： queuerev2 回答日時： 2012/07/22 22:23

No.1さんへの補足に対する回答になってしまいますが、横から失礼いたします。

Range("Bj:Jj").Select
ですが、これはBJ列からJJ列を選択するという意味になると思います。
Range("B" & j & ":J" & j).Select
としたらうまくいく可能性があるのではないでしょうか。
あるいは、貼り付け先は左上の1つのセルだけを選択すればいいはずなので、
Range("B" & j).Select
でいかがでしょう。

No.1 回答者： hallo-2007 回答日時： 2012/07/13 20:28

お互いが、エクセルのファイルで、ADOを使用してですか？

アクセス経験者の方かと思いますが、とりあえず
エクセルのフィルターオプションの機能を試してみては如何でしょうか？
エクセル2000では確認できませんが、エクセルを使うのであればエクセルの機能を使った方が
便利で簡単です。この場合はVlookup関数ではなくフィルター　オプション
http://www.eurus.dti.ne.jp/yoneyama/Excel/filter …
を参考に説明しますと
Book2の1行目は　フィールド名　です。
Book1の　A1~B3　に抽出の条件があるとします。
Book1の4行目以降に、結果を表示させるとします。

試した操作は、Book1からフィルター明細設定（2010の場合）
フィルターオプション
抽出した範囲に　チェック
リスト範囲　　　Book1のA~G列
抽出条件の範囲　Book2のA1～B2
抽出範囲　　　　Book2のA4~G4

を実行させたら、A2~B2で指定した条件にあったデータが抽出されました。
マクロの記録の結果は
Sub Macro1()
Workbooks("book1.xls").Sheets("データ").Columns("A:G").AdvancedFilter Action _
:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("A4:F4") _
, Unique:=False
End Sub
と1行で済みます。
マクロの考え方ですが、Book1のシート上のボタンを押すと
Book2を開いて、指定したフィルターオプションを実行して
Book2を閉じる。

もちろん、途中の動作の表示が不要であれば表示をしない方法もあります。
フォーム上のテキストボックスを使うことも可能ですが、特に問題なければ
シートのセルを利用してみてh如何でしょうか。

この回答への補足

いま、また新しくマクロを組んでいるのですが・・・
---------------------------------------------
Private Sub CommandButton2_Click()
For i = 2 To Worksheets.Count
For j = 2 To Worksheets(i).UsedRange.Rows.Count
If Worksheets(i).Range("B" & j).Text = UserForm1.ComboBox1.Value And _
Worksheets(i).Range("C" & j).Text = UserForm1.ComboBox2.Value And _
Worksheets(i).Range("D" & j).Text = UserForm1.ComboBox3.Value And _
Worksheets(i).Range("E" & j).Text = UserForm1.ComboBox4.Value And _
Worksheets(i).Range("F" & j).Text = UserForm1.ComboBox5.Value And _
Worksheets(i).Range("G" & j).Text = UserForm1.ComboBox6.Value Then
MsgBox i & "番目のシートの" & j & "行目に存在します。"
Exit Sub
End If
Next
Next
MsgBox "存在しませんでした"
End Sub
---------------------------------------------

で作成し、メッセージに表示される行の対象セルを検索をしているシートに抽出したいのですが...

---------------------------------------------
Private Sub CommandButton2_Click()
For i = 2 To Worksheets.Count
For j = 2 To Worksheets(i).UsedRange.Rows.Count
If Worksheets(i).Range("B" & j).Text = UserForm1.ComboBox1.Value And _
Worksheets(i).Range("C" & j).Text = UserForm1.ComboBox2.Value And _
Worksheets(i).Range("D" & j).Text = UserForm1.ComboBox3.Value And _
Worksheets(i).Range("E" & j).Text = UserForm1.ComboBox4.Value And _
Worksheets(i).Range("F" & j).Text = UserForm1.ComboBox5.Value And _
Worksheets(i).Range("G" & j).Text = UserForm1.ComboBox6.Value Then
Worksheets(i).Select
Range("Bj:Jj").Select
Selection.CurrentRegion.Copy
Sheets("検索").Select
Range("B2").PasteSpecial Paste:=xlValues
Exit Sub
End If
Next
Next
MsgBox "存在しませんでした"
End Sub
---------------------------------------------

検索はされるのですが、シートに抽出されません。
どのようにマクロを組めばいいか分かりません。
よろしくお願いします。

補足日時：2012/07/19 17:04

この回答へのお礼

ご回答いただきありがとうございます。
早速、参考にさせていただいたのですが、中々上手く行きません・・・。
もう少し粘ってみようかと思います。

お礼日時：2012/07/19 16:55