[[20130710052937]]　『別ファイルのセルを返す』（May）　ページの最後に飛ぶ

『別ファイルのセルを返す』（May）

今「May.xls」というファイルを開いています。
「May.xls」のSheet1のA1に「test01」と入力すると隣のB1セルに、
別フォルダに保存されている「test01.xls」のSheet3のD5セル値が表示され、
また「test02」と入力すると「test02.xls」のSheet3のD5セル値を表示させたいです。
INDIRECT関数では「testXX.xls」が開いていないとエラーになってしまうので無理でした。
関数で他のやり方があるのか、またはマクロを組む場合参考となるページ等をご教示願えれば幸いです。
宜しくお願いします。

[[20100108094343]]

 A1 = c:\test\ の様な実際のファイルパス
 B1 = test01  ブック名
 C1 = sheet3  シート名

 が夫々記入されている前提で
 =Pull("'"&A1&"\["&B1&".xls]"&C1&"'!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
    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)

コメント返信：

[ 一覧(最新更新順) ]

[[20130710052937]] 『別ファイルのセルを返す』（May） ページの最後に飛ぶ

[[20130710052937]]　『別ファイルのセルを返す』（May）　ページの最後に飛ぶ