お気持ちのみですが、合計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"を返します。

回答の条件
  • 1人2回まで
  • 登録:2008/12/21 18:54:20
  • 終了:2008/12/22 13:06:19

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/12/21 20:16:12

ポイント110pt

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

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

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

しまいます。


このため、下記のサンプルでは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
id:ReoReo7

ありがとうございます。

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

2008/12/22 13:05:30

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/12/21 20:16:12ここでベストアンサー

ポイント110pt

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

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

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

しまいます。


このため、下記のサンプルでは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
id:ReoReo7

ありがとうございます。

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

2008/12/22 13:05:30
id:pahoo No.2

pahoo回答回数5960ベストアンサー獲得回数6332008/12/21 22:10:39

ポイント40pt

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


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

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

  • ReturnMojiの型は String
  • FromLine:検索する列。
  • ToLine:一致時に返す列。
  • 検索は完全一致。英小文字/大文字を区別。
  • 複数一致時には先頭行の ToLine を返す。
  • 一致しないときには空文字列 "" を返す。
id:ReoReo7

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

2008/12/22 13:05:51
  • id:pahoo
    要件について、もう少し確認したいことがあります。

    1)"excelsample.xls" の中にVBAを記述する方法でよいですか? それとも、他のXLSファイルのVBAから "excelsample.xls" を参照する必要がありますか?
    2)検索結果が複数になったときにはどうしますか? 最初に一致した行の「付属情報」だけ返せばよいですか?
  • id:ReoReo7
    ありがとうございます。

    1)"excelsample.xls" の中にVBAを記述する方法でよいですか? それとも、他のXLSファイルのVBAから "excelsample.xls" を参照する必要がありますか?
    →他のXLSファイル(ExcelWithMacro.xls)のVBAから "excelsample.xls" を参照する必要があります。今回はこの方法が分からないために、質問させて頂きました。
    excelsample.xlsファイルの場所は
    "C:\Documents and Settings\Administrator\My Documents\DB\excelsample.xls"
    ではなく、
    ExcelWithMacro.xlsの保存されているフォルダにある"excelsamples"フォルダ
    として頂けませんでしょうか?仕様の変更があり申し訳ありません。

    2)検索結果が複数になったときにはどうしますか? 最初に一致した行の「付属情報」だけ返せばよいですか?
    →はい。最初に一致した行のデータだけ返せばよいです。ただし、返すのは「付属情報」ではなく、関数の3つ目の引数(integer)で指定した列でお願いします。

    よろしくお願いします。
  • id:Mook
    あわてるとろくなことがない・・・。

    意味のないコードになっていました。
      Application.ScreenUpdating = True
      ThisWorkbook.Activate

      ThisWorkbook.Activate
      Application.ScreenUpdating = True
    のように順序を逆に修正ください。
    失礼しました。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません