Я провел несколько исследований по поводу вашего запроса, и, похоже, нет способа сделать это.В зависимости от вашей версии Excel (год, x32 x64) я нашел следующие решения (у меня Excel 2013 x64, и у меня нет ни одного из них):
- MoreFunc : MOREFUNC - этоНадстройка для Excel, предлагающая 67 новых функций листа для Excel 95-2007 и, возможно, 2010 и 2013 для 32-разрядной версии.Он содержит эту функцию: INDIRECT.EXT: возвращает содержимое ячейки или диапазона, содержащегося в закрытой рабочей книге
MoreFunc download
Функция VBA : Я нашел 2 функции VBA.Как первое решение, оно работает в зависимости от версии Excel.
- IndirectEx (): расширенная функция INDIRECT v1.0 от Wilson So.
'------------------------------------ «Расширенная функция INDIRECT v1.0» ----------------------------------- 'Copyright (c) 2009 Wilson So.'E-mail: @ ' ------------------------------------ 'Кредиты:' - Разработано и написано Уилсоном Со.'- Уловка' CreateObject ("Excel.Application") "была вдохновлена исходным кодом функции PULL Харлана Гроува.'------------------------------------' Это открытый исходный код.Вы можете свободно распространять и изменять его, но, пожалуйста, просим отдать должное авторам.Просьба также сообщать о любых ошибках / предложениях по электронной почте или на форумах, где я их опубликовал.'------------------------------------' Как использовать: '- В основном то же, что и INDIRECT ()в Excel - та же концепция для параметра ref_text.'- Чтобы обновить статическую память для конкретной ссылки,' введите TRUE во втором параметре (только один из IndirectEx (), содержащий эту ссылку) 'и вычислите его один раз.'------------------------------------' Особенности: '- Вы можете обратиться к данным закрытой рабочей книги,«- Полученные данные закрытой рабочей книги будут сохранены в статической памяти», поэтому в следующий раз закрытая рабочая книга не будет снова открыта для быстрого восстановления.'- диапазон вместо массива будет возвращен, если путь не указан в ref_text', поэтому он по-прежнему работает нормально, если пользователь ссылается на огромный массив, например "Sheet1! 1: 65536".'- Вы можете использовать его внутри INDEX (), VLOOKUP (), MATCH () и т. Д.' - Вы можете использовать его с OFFSET (), но только для открытых данных рабочей книги.'- процедура не будет слепо извлекать все данные в соответствии с запросом;он не будет извлекать данные за пределы ячейки «Ctrl + End», чтобы сохранить как можно меньше памяти.'- #NUM!будет возвращен в случае нехватки памяти.'- #REF!будет возвращен в случае неправильного пути.'- #ЗНАЧЕНИЕ!будет возвращен в случае других ошибок.'------------------------------------' Известные проблемы: '- Из-за использования SpecialCells (), #ЗНАЧЕНИЕ!будет возвращено, если рабочая таблица для закрытой рабочей книги защищена.'-----------------------------------
-
Function IndirectEx(ref_text As String, Optional refresh_memory As Boolean = False) As Variant
On Error GoTo ClearObject
Dim RefName As String
Dim SheetName As String
Dim WBName As String
Dim FolderName As String
Dim vExcel As Object
Dim vWB As Workbook
Static dbOutput() As Variant
Static dbKey() As String
Static dbTotalOutput As Integer
Dim dbIndex As Integer
Dim UserEndRow As Long, UserEndCol As Integer
Dim RealEndRow As Long, RealEndCol As Integer
Dim EndRow As Long, EndCol As Integer
Dim RangeHeight As Long, RangeWidth As Integer
GetNames ref_text, RefName, SheetName, WBName, FolderName
If dbTotalOutput = 0 Then
ReDim dbOutput(1 To 1) As Variant
ReDim dbKey(1 To 1) As String
End If
For i = 1 To dbTotalOutput
If dbKey(i) = FolderName & WBName & "!" & SheetName & "!" & RefName Then
dbIndex = i
End If
Next
If dbIndex = 0 Or refresh_memory Then
If dbIndex = 0 Then
dbTotalOutput = dbTotalOutput + 1
dbIndex = dbTotalOutput
ReDim Preserve dbOutput(1 To dbTotalOutput) As Variant
ReDim Preserve dbKey(1 To dbTotalOutput) As String
dbKey(dbIndex) = FolderName & WBName & "!" & SheetName & "!" & RefName
End If
If FolderName = "" Then
Set dbOutput(dbIndex) = Workbooks(WBName).Worksheets(SheetName).Range(RefName)
ElseIf Dir(FolderName & WBName) <> "" Then
Set vExcel = CreateObject("Excel.Application")
Set vWB = vExcel.Workbooks.Open(FolderName & WBName)
With vWB.Sheets(SheetName)
On Error GoTo ClearObject
UserEndRow = .Range(RefName).Row + .Range(RefName).Rows.Count - 1
UserEndCol = .Range(RefName).Column + .Range(RefName).Columns.Count - 1
RealEndRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
RealEndCol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
EndRow = IIf(UserEndRow < RealEndRow, UserEndRow, RealEndRow)
EndCol = IIf(UserEndCol < RealEndCol, UserEndCol, RealEndCol)
RangeHeight = EndRow - .Range(RefName).Row + 1
RangeWidth = EndCol - .Range(RefName).Column + 1
On Error Resume Next
dbOutput(dbIndex) = .Range(RefName).Resize(RangeHeight, RangeWidth).Value
If Err.Number <> 0 Then
IndirectEx = CVErr(xlErrNum)
GoTo ClearObject
End If
End With
On Error GoTo ClearObject
vWB.Close False
vExcel.Quit
Set vExcel = Nothing
Else
IndirectEx = CVErr(xlErrRef)
Exit Function
End If
End If
If TypeOf dbOutput(dbIndex) Is Range Then
Set IndirectEx = dbOutput(dbIndex)
Else
IndirectEx = dbOutput(dbIndex)
End If
Exit Function
ClearObject:
On Error Resume Next
If Not (vExcel Is Nothing) Then
vWB.Close False
vExcel.Quit
Set vExcel = Nothing
End If
End Function
Private Sub GetNames(ByVal ref_text As String, ByRef RefName As String, ByRef SheetName As String, ByRef WBName As String, ByRef FolderName As String)
Dim P_e As Integer
Dim P_b1 As Integer
Dim P_b2 As Integer
Dim P_s As Integer
P_e = InStr(1, ref_text, "!")
P_b1 = InStr(1, ref_text, "[")
P_b2 = InStr(1, ref_text, "]")
P_s = InStr(1, ref_text, ":\")
If P_e = 0 Then
RefName = ref_text
Else
RefName = Right$(ref_text, Len(ref_text) - P_e)
End If
RefName = Replace$(RefName, "$", "")
If P_e = 0 Then
SheetName = Application.Caller.Parent.Name
ElseIf P_b1 = 0 Then
SheetName = Left$(ref_text, P_e - 1)
Else
SheetName = Mid$(ref_text, P_b2 + 1, P_e - P_b2 - 1)
End If
SheetName = Replace$(SheetName, "'", "")
If P_b1 = 0 Then
WBName = Application.Caller.Parent.Parent.Name
Else
WBName = Mid$(ref_text, P_b1 + 1, P_b2 - P_b1 - 1)
End If
If P_s = 0 Then
FolderName = ""
Else
FolderName = Left$(ref_text, P_b1 - 1)
End If
If Left$(FolderName, 1) = "'" Then FolderName = Right$(FolderName, Len(FolderName) - 1)
End Sub
- PULL (): Харлан Гроув
, вдохновленный Бобом Филлипсом и Лораном Лонгром, но написанный Харланом Гроувом ----------------------------------------------------------------- 'Copyright (c) 2003 Harlan Grove.«Этот код является свободным программным обеспечением;вы можете распространять его и / или изменять «в соответствии с условиями Стандартной общественной лицензии GNU, опубликованной» Free Software Foundation;либо версия 2 лицензии, либо (по вашему выбору) любая более поздняя версия.«-----------------------------------------------------------------
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
pull = Evaluate(xref)
If CStr(pull) = CStr(CVErr(xlErrRef)) Then
On Error GoTo CleanUp 'immediate clean-up at this point
Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro
On Error Resume Next 'now clean-up can wait
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