[[20100108094343]]　『別ファイル名をsheet上で指定してそのファイルを普x（るっちん）　ページの最後に飛ぶ

『別ファイル名をsheet上で指定してそのファイルを閉じた状態でデータを抽出したい』（るっちん）

 初歩的なことかもしれませんが質問をさせて下さい。
 例えばCドライブ上にある別のエクセルファイルがいくつかあり、
 そのファイルの名前が500、550、700…といった形で保存されているとします。

 この状態でA列にそのファイル名と同じ数字を入力すると、
 B列にそのファイル名のあるセルの数値が表示されるようにしたいのですが
 どうすれば良いでしょうか？

 とりあえずこんな式を入れてみましたがダメでした。
 ='["&A1&".xls]'sheet1!$C$25
 ファイルは閉じたままで出力をしたいです。

 よろしくお願い致します。

 閉じたファイルのデータはIndirect関数等のエクセル関数では取得できません。

 とりあえずUPしておきます。
 下記コードはHarlan Grove氏が書かれたものです。

 1) Alt + F11 でVBEを起動
 2) [挿入] - [標準モジュール] 右空白部分に下記コードを貼り付けてVBEを閉じる。
 3) 使用例

 A1が ["&A1&".xls]'sheet1!$C$25
 であれば
 =pull("'c:\test\"&A1)
 ファイルパスは実際のものに変更してください。

 検証はしていませんが、機能するはずです。

 Function pull(xref As String) As Variant 
  Dim xlapp As Object, xlwb As Workbook 
  Dim b As String, r As Range, C As Range, n As Long

  n = InStrRev(xref, "\")

  If n > 0 Then 
    If Mid(xref, n, 2) = "\[" Then 
      b = Left(xref, n) 
      n = InStr(n + 2, xref, "]") - n - 2 
      If n > 0 Then b = b & Mid(xref, Len(b) + 2, n) 
    Else 
      n = InStrRev(Len(xref), xref, "!") 
      If n > 0 Then b = Left(xref, n - 1) 
    End If 
    If Left(b, 1) = "'" Then b = Mid(b, 2) 
    On Error Resume Next 
    If n > 0 Then If Dir(b) = "" Then n = 0 
    Err.Clear 
    On Error GoTo 0 
  End If 
  If n <= 0 Then 
    pull = CVErr(xlErrRef) 
    Exit Function 
  End If 
  pull = Evaluate(xref)  
  If IsArray(pull) Then Exit Function 
  If CStr(pull) = CStr(CVErr(xlErrRef)) Then 
    On Error GoTo CleanUp
    Set xlapp = CreateObject("Excel.Application") 
    Set xlwb = xlapp.Workbooks.Add  'needed by .ExecuteExcel4Macro

    On Error Resume Next

    n = InStr(InStr(1, xref, "]") + 1, xref, "!") 
    b = Mid(xref, 1, n)

    Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))

    If r Is Nothing Then 
      pull = xlapp.ExecuteExcel4Macro(xref) 
    Else 
      For Each C In r 
        C.Value = xlapp.ExecuteExcel4Macro(b & C.Address(1, 1, xlR1C1)) 
      Next C 
      pull = r.Value 
    End If 
 CleanUp: 
    If Not xlwb Is Nothing Then xlwb.Close 0 
    If Not xlapp Is Nothing Then xlapp.Quit 
    Set xlapp = Nothing 
  End If 
 End Function
 (seiya)

回答ありがとうございます。
残念ながらうまくいきませんでしたが、設定などがおかしいのかもしれませんのでちょっと頑張ってみます。

A1にファイル名を入力して，（例えば，sample.xls)

 =pull("'c:\test\["&A1&"]sheet1'!$C$25)
としたら上手くいきました．
（この場合，sample.xlsのsheet1のセルC25の値を参照します．）

hyouga

コメント返信：

[ 一覧(最新更新順) ]

[[20100108094343]] 『別ファイル名をsheet上で指定してそのファイルを普x（るっちん） ページの最後に飛ぶ

[[20100108094343]]　『別ファイル名をsheet上で指定してそのファイルを普x（るっちん）　ページの最後に飛ぶ