对单元格中指定的文件名使用间接()的非易失性替代方法

Question

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

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

sheet1上的单元格D6中键入了文件名，例如"Book2“

sheet1上的单元格H6键入了文件扩展名，例如".xls“

然后引用单元格A1为：'Book2.xlsPage1'!A1

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

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

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

因此，当我想在工作簿上引用文件名为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来实现您所需的内容，但它可能会更长一些。

使用打开文件的编辑

此函数将检查“目标”文件是否打开，如果没有打开。根据您提供的函数参数，它将关闭文件或不关闭文件。所编写的函数需要六个参数才能提供最大的灵活性。当然，您可以根据需要调整这些设置。可能需要指定“当前工作文件夹”。如果目标文件已打开但尚未保存，则当前工作文件夹默认为“users”文件夹，这可能会有问题。在我的示例中，我显式地指定了单元格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

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

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