>同一ファイル内では取得することができたのですが、他のブックではうまくいきません。

マクロの経験の浅い方は、良く考える質問です。本来は、VBAは、やはりブックを開けて、そこから探すというのが、ロジカルです。以下は、可読性が悪いので、一度作ったら、あまり変更できないことが多いです。裏技の一種です。また、Vlookup 関数の被検索範囲は、基本的には、昇順・降順など、きちんと並んでいなければ、正しくは出てきません。また、VBAでは、Vlookup関数などは、ほとんど使われません。

'//
Sub VlookupAvailable()
　　Dim sPath As String
　　Dim sFname As String
　　Dim sSheet As String
　　Dim sRng As String
　　Dim sAdd As String
　　Dim sCol As String

　　Dim sSrch As String
　　Dim n As Long
　　Dim ret1 As Variant
　　Dim ret2 As Variant
　　Dim ret3 As Variant
　　Dim ret4 As Variant
　　
　　sPath = "C:\"
　　sFname = "TestBook1.xls"
　　sSheet = "Sheet1"
　　sRng = "A1:C100"
　　sCol = 2 '検索列
　　sAdd = Range(sRng).Address(1, 1, xlR1C1)
　　
　　sSrch = "1" '検索値
　　If Not IsNumeric(sSrch) Then sSrch = """" & sSrch & """"
　　Debug.Print "VLOOKUP(" & sSrch & ",'" & sPath & "[" & sFname & "]" & sSheet & "'!" & sAdd & "," & sCol & ",FALSE)"
　　ret1 = ExecuteExcel4Macro("VLOOKUP(" & sSrch & ",'" & sPath & "[" & sFname & "]" & sSheet & "'!" & sAdd & "," & sCol & ",FALSE)")
　　If Not (IsError(ret1)) Then
　　　　MsgBox ret1
　　 Else
　　　　MsgBox "見つかりません。マクロ終了", vbExclamation
　　　　Exit Sub '終了
　　End If
　　sAdd = Range(sRng).Columns(CLng(sCol)).Address(1, 1, xlR1C1)
　　
　　If IsError(ret1) = False Then
　　　 If IsNumeric(ret1) = False Then
　　　　　ret1 = """" & ret1 & """"
　　　 End If
　　Else
　　　 Exit Sub
　　End If
　　If Not (IsError(ret1)) Then
　　　　ret2 = ExecuteExcel4Macro("MATCH(" & ret1 & ",'" & sPath & "[" & sFname & "]" & sSheet & "'!" & sAdd & ",FALSE)")
　　　　If Not (IsError(ret2)) Then
　　　　　If IsNumeric(ret2) Then
　　　　　　 n = ret2
　　　　　　 sAdd = Range(sRng).Cells(n - 1, CLng(sCol)).Address(1, 1, xlR1C1)
　　　　　　 ret3 = ExecuteExcel4Macro("'" & sPath & "[" & sFname & "]" & sSheet & "'!" & sAdd)
　　　　　　
　　　　　　 sAdd = Range(sRng).Cells(n + 1, CLng(sCol)).Address(1, 1, xlR1C1)
　　　　　　 ret4 = ExecuteExcel4Macro("'" & sPath & "[" & sFname & "]" & sSheet & "'!" & sAdd)
　　　　　　 MsgBox "前は、" & ret3 & vbCrLf & _
　　　　　　　　　　"後ろは、" & ret4
　　　　　End If
　　　　End If
　　End If
End Sub

投稿日時 - 2010-05-11 01:36:23