非易失性替代使用INDIRECT（）作为单元格中指定的文件名称
我正在寻找一种非易失性的方式，从单元格中指定的手动input的文件path中指定对另一个工作簿中单元格的引用。 我需要一个非易失性的方式，因为我需要引用单元格使用这种方法可能会成千上万次，这将缓慢超出停止，否则。 我目前使用这个公式
INDIRECT("'["&Sheet1!$D$6&Sheet1!$H$6&"]"&"Page1"&"'!"&"A1")) 工作表1上的单元格D6具有在其中键入的文件名称，例如“Book2”
sheet1上的单元格H6具有在其中键入的文件扩展名，例如“.xls”
然后这引用单元格A1：'[Book2.xls] Page1'！A1
这是我想实现，但使用非易失性方法，我知道我将不得不使用VBA，所以我需要一个函数，如下所示
– 引用文件名和文件扩展名的两个单元格D6和H6
– 文件path需要始终作为位置可以改变的当前目录
所以我可以使用这样的function，当我想引用我的工作簿上的单元格文件名是在单元格D6和H6
FILE(Page1!A1)
显然在VBA中没有可以从一个封闭的工作簿返回一个单元格值的本地函数。 然而，在VBA的先驱，一种叫做XLM的语言中，有一套由ExecuteExcel4Macro调用的函数，它们尚未升级为VBA，但是向后兼容。 这个build议使用这些Application调用之一。 毫无疑问，需要进一步完善以满足您的需求。
我使用约翰·沃肯巴赫的这篇文章作为这个build议的基础。
你也可以find这个页面作为进一步研究的起点。
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也有可能实现你所需要的，但可能会更长一些。
编辑使用打开的文件
此function将检查'目标'文件是否打开，如果不打开它。 根据您提供的函数参数，它将closures文件或不。 所写的function需要六个参数来给你最大的灵活性。 你当然可以调整这些以适应。 可能需要指定“当前工作文件夹”。 如果目标文件已经打开但尚未保存，那么当前工作文件夹将默认为“用户”文件夹，这可能会造成问题。 对于我的例子，我明确指定了单元格J6中的“工作目录”，并将函数返回值写回单元格A6。
我也给出了一个调用Sub的例子，可以让你调整/理解各种“设置”。
function
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
我已经使用这篇文章作为波动的参考。 虽然由于自己的知识不完整，我不认为我的build议违反了那里提出的任何要点（除了可能会开放一个工作簿？），我不认为这是明确的。
我认为你必须将用户定义的函数标记为volatile，否则它是非易失性的。
这将在用户定义的函数中使用Application.Volatile方法完成。