人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

お気持ちのみですが、合計150p程度の質問とさせて頂きます。エクセルVBAマクロのファイルの参照について質問です。

あるエクセルファイル(例えば場所:
C:\Documents and Settings\Administrator\My Documents\DB\excelsample.xls
)に、データ


ID,検索キー,対応文字,付属情報
1, key1, ABC, hoge
2, key2, DEF, hogeho
3, keyX, XYZ, hogehoge

の4列のデータが格納されていたとします。

このとき、マクロである検索キーワードから対応する列の文字を返す関数

Function ReturnMoji(From as string, FromLine as integer, ToLine as integer)

を作って下さい。

実行結果としては例えば

ReturnMoji("key1", 2, 3)
は"ABC"を返し、

Return Moji("2", 1, 4)
は"hogeho"を返します。

●質問者: ReoReo7
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:ABC as dB def hoge
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●110ポイント ベストアンサー

本来はユーザ定義関数をご希望のように思えますが、ユーザ定義関数内ではファイルを開くことができず、

事前にファイルを開いておかないと使用できません。

また一度結果が表示されても、再度開いた際に参照先のファイルが開いていないと内容が表示されなくなって

しまいます。


このため、下記のサンプルではVB 内で変換処理を行い、結果を静的に持つように変換しています。

シートから処理をしたいのであれば、引数となる数値をA、B、C列に置き、D列に結果を出すようなコードに

してはどうでしょうか。

その場合の例は Main2になります。


検索に該当がない場合等、エラー文字を出すようにしていますが、出したくない場合は""に置き換えてください。

Option Explicit

Const keyTablePath = "C:\Documents and Settings\Administrator\My Documents\DB\"
Const keyTableFile = "excelsample.xls"

'-----------------------------------------------------------------------------------
Sub main()
'-----------------------------------------------------------------------------------
' サンプル関数1:A1、A2に結果を出力
'-----------------------------------------------------------------------------------
 OpenKeyTable

 Range("A1") = ReturnMoji("key1", 2, 3)
 Range("A2") = ReturnMoji("2", 1, 4)
End Sub

'-----------------------------------------------------------------------------------
Sub main2()
'-----------------------------------------------------------------------------------
' サンプル関数2: A,B,C列を引数に、結果をDに出力
'-----------------------------------------------------------------------------------
 OpenKeyTable

 Dim i As Long
 For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
 Cells(i, "D").Value = ReturnMoji(Cells(i, "A").Value, Cells(i, "B").Value, Cells(i, "C").Value)
 Next
End Sub


'-----------------------------------------------------------------------------------
Sub OpenKeyTable()
'-----------------------------------------------------------------------------------
' ファイルが開いていなかったら開く
'-----------------------------------------------------------------------------------
 Dim kWB As Workbook
 On Error Resume Next
 Set kWB = Workbooks(keyTableFile)
 On Error GoTo 0
 
 Application.ScreenUpdating = False
 If kWB Is Nothing Then
 Workbooks.Open keyTablePath & keyTableFile
 End If
 Application.ScreenUpdating = True
 ThisWorkbook.Activate
End Sub

'-----------------------------------------------------------------------------------
Function ReturnMoji(FromKeyWord As String, FromLine As Integer, ToLine As Integer)
'-----------------------------------------------------------------------------------
 Dim keyWB As Workbook
 On Error Resume Next
 Set keyWB = Workbooks(keyTableFile)
 On Error GoTo 0
 
 If keyWB Is Nothing Then
 ReturnMoji = "#ERR NO FILE"
 Exit Function
 End If
 
 Dim res As Range
 Set res = keyWB.Worksheets(1).Columns(FromLine).Find(what:=FromKeyWord, lookat:=xlWhole)
 If res Is Nothing Then
 ReturnMoji = "#Not Found"
 Else
 ReturnMoji = keyWB.Worksheets(1).Cells(res.Row, ToLine).Value
 End If
End Function
◎質問者からの返答

ありがとうございます。

所望の動作が得られました!


2 ● pahoo
●40ポイント

こんな感じでどうでしょう。


Function ReturnMoji(From As String, FromLine As Integer, ToLine As Integer) As String
 bookpath = "" '他のディレクトリの場合に指定してください
 bookname = "excelsample.xls"
 sheetname = "Sheet1"
 Set wb = Application.Workbooks.Open(bookpath & bookname)
 '検索文字列
 Set obj = Worksheets(sheetname).Columns(FromLine).Find(From, LookAt:=xlWhole)
 If obj Is Nothing Then
 ReturnMoji = ""
 Else
 ReturnMoji = Worksheets(sheetname).Cells(obj.Row, ToLine).Value
 End If
End Function

Sub main()
 s = ReturnMoji("key1", 2, 3)
 MsgBox (s)
End Sub

以下の点を要件に加えました。

◎質問者からの返答

ありがとうございます。こんなやり方もあるのですね。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ