Question

我正在寻找一种非易失性方法，用于从单元格中指定的手动输入的文件路径指定对另一个工作簿中的单元格的引用。我需要一种非易失性的方式，因为我需要使用这种方法引用单元格可能会成千上万次，否则会慢慢停止。我目前正在使用这个公式

INDIRECT("'["&Sheet1!$D$6&Sheet1!$H$6&"]"&"Page1"&"'!"&"A1"))

sheet1上的单元格D6具有键入的文件名，例如“Book2”

sheet1上的单元格H6的文件扩展名为“.xls”

然后将单元格A1引用为：'[Book2.xls] Page1'！A1

这是我想要实现的但是使用非易失性方法，我知道我将不得不使用VBA所以我需要一个函数来工作如下

- 引用两个单元格D6和H6作为文件名和文件扩展名

- 文件路径需要始终是当前目录，因为位置可以更改

所以当我想在工作簿中引用文件名在单元格D6和H6中的单元格时，我可以使用这样的函数

FILE(Page1!A1)

Answer 1

显然，VBA中没有可以从已关闭的工作簿返回单元格值的本机函数。但是，在VBA的前身，一种名为XLM的语言，有一套由ExecuteExcel4Macro调用的函数，这些函数尚未针对VBA进行升级，但是向后兼容。此建议使用其中一个Application调用。毫无疑问，需要进一步完善以满足您的需求。

我使用this article by John Walkenbach作为此建议的基础。

您可能还会发现this page有助于进一步研究。

Sub readClosed()
Dim fName As String, fExt As String, fDir As String
Dim destCell As Range

'closed file info
fName = ActiveWorkbook.Sheets("Sheet1").Cells(6, 4).Value   'Sheet1!D6
fExt = ActiveWorkbook.Sheets("Sheet1").Cells(6, 8).Value    'Sheet1!H6
fDir = CurDir() & "\"   'currently selected folder

'destination cell for result returned
Set destCell = ActiveWorkbook.Sheets("Sheet1").Cells(10, 2)

'create string for function call
arg = "'" & fDir & "[" & fName & fExt & "]" & "Page1" & "'!" & _
      Range("A1").Range("A1").Address(, , xlR1C1)

'call function
destCell = Application.ExecuteExcel4Macro(arg)

End Sub

ADO也可以实现您的需求，但可能会更长。

编辑使用开放文件

此功能将检查“目标”文件是否已打开，是否未打开。根据您提供的函数参数，它将关闭文件。写入的函数需要六个参数才能为您提供最大的灵活性。您当然可以调整这些以适应。可能需要指定“当前工作文件夹”。如果目标文件已打开但尚未保存，则当前工作文件夹将默认为“用户”文件夹，这可能会有问题。对于我的例子，我已经在单元格J6中明确指定了“工作目录”，并将函数返回值写回到单元格A6。

我还给出了一个调用Sub的示例，其中包含允许您调整/理解各种“设置”的详细信息。

<强>功能

Function readValue(ByVal fDir As String, _
                   ByVal fName As String, _
                   ByVal fExt As String, _
                   ByVal fSheet As String, _
                   ByVal fCell As String, _
                   ByVal fClose As Boolean) As Variant

Dim wb As Workbook
Dim ws As Worksheet
Dim wbOpen As Boolean

wbOpen = False
readValue = ""

    'is tgtWb already open
    For Each wb In Workbooks
        If wb.Name = fName & fExt Then
            wbOpen = True
            Exit For
        End If
    Next wb

    'if not open it
    If Not wbOpen Then
        If Dir(fDir & fName & fExt) <> "" Then
            Workbooks.Open filename:=fDir & fName & fExt
        Else
            MsgBox "Workbook not found."
            Exit Function
        End If
    End If

'does worksheet exist
On Error Resume Next
Set ws = Workbooks(fName & fExt).Sheets(fSheet)
On Error GoTo 0
    If Not ws Is Nothing Then
        readValue = Workbooks(fName & fExt).Sheets(fSheet).Range(fCell).Value
    Else
        MsgBox "Sheet not found."
    End If

'close target workbook if required
    If fClose Then
        Workbooks(fName & fExt).Close savechanges:=False
    End If

End Function

调用子示例

Sub test()
'Retrieve a single cell value from another workbook
'Place value in ThisWorkbook.wkgSht.destCell
'Other workbook can be open or closed
'Other workbook can be left open or closed by function

Dim fDi As String, fNa As String, fEx As String
Dim fSh As String, fCe As String
Dim wkgSht As String, destCell As String
Dim closeFile As Boolean

'destination cell for returned value, in ThisWorkbook
destCell = "A6"
'sheet containing target file details and destination cell, in ThisWorkbook
wkgSht = "Sheet1"

'target file info/arguments for function call
fCe = "A1"
fSh = "Page1"
fNa = ThisWorkbook.Sheets(wkgSht).Cells(6, 4).Value   'Sheet1!D6
fEx = ThisWorkbook.Sheets(wkgSht).Cells(6, 8).Value    'Sheet1!H6
'fDi = CurDir() & "\"   'currently selected folder
fDi = ThisWorkbook.Sheets(wkgSht).Cells(6, 10).Value    'Sheet1!J6  'for testing

'call function and place returned value in destCell
ThisWorkbook.Sheets(wkgSht).Range(destCell).Value = readValue(fDi, fNa, fEx, fSh, fCe, False)

End Sub

编辑2

我使用this article作为波动的参考。我不认为我的建议违反了那里提出的任何要点（除了可能打开一本工作簿？），虽然由于我自己的不完整知识，我不认为这是明确的。

Answer 2

我认为你必须将用户定义的函数标记为volatile，否则它是非易失性的。

这将通过用户定义函数中的Application.Volatile方法完成。

非易失性替换为在单元格中指定的文件名使用INDIRECT（）

2 个答案: