在我的目录c：/ test中我有多个名为“xx-xxxxx.xlsm”的工作簿，其中“xx-xxxxx”是特定文件中记录的汽车的注册号。
在所有xx-xxxxx.xlsm文件中都有一个名为“Summary”的工作表，在此工作表中，所有工作簿中的数据结构相同 - b1是reg.nr.，b2是cartype，b3是购买日期，b4是用户等。
现在我想制作一个带有masterTABLE表的masterworkbook，它总结了一个表中的所有summarysheets而无需打开单个工作簿。 在此表中，我在列A中有reg.no，在列B中有cartype，在列C中购买，在列D中有用户，等等。
显而易见的解决方案是制作一个公式：='C：/ test / [xx-xxxxx.xlsm] Table'！$ b $ 2，然后手动插入相应的文件名。但是因为我有reg.no.在主表的第一列和文件名中的相同reg.no（以及MANY cars / files / rows / columns）中，我希望有一个像''C：/ test / [b2] Table'这样的公式！$ b $ 2或VLOOKUP，只需将其复制到每列/每行。但这当然不起作用。
我已尝试过其他用户在此论坛和其他论坛中提出的类似挑战的其他解决方案，但它们对我不起作用（即我在VBA中没有足够的能力修改根据我的需求建议的宏。
我想要的是在masterworkbook中的masterTable表中，在第一列和一个记录/汽车pr行中拥有汽车的所有注册号，并且基于这个数字，我想要B列中的公式/宏在所有单独的工作簿中从A3获取cartype，在CI列中需要一个公式，从所有工作簿中获取A4的购买日期。
此外，在masterworkbook中，我希望有一个SETUP表，我在其中写入目录的路径，即c：/ test，以便它可以在公式/宏中使用，这是上述问题的解决方案。或者，如果路径可以从保存活动主工作簿的目录中自动导出。
有人可以帮助我吗？
请注意我是VBA的新手，需要大声清楚解释;）
提前谢谢你：）
答案 0 :(得分：0)
是的，您可以构建一个将从另一个工作簿中提取的公式。例如如果你的注册。没有。在A2中，你的路径在Setup！A1然后是一个公式，如
=INDIRECT("'[" & Setup!A1 & A2 & ".xlsx]Summary'!B2")
将起作用 - 请注意INDIRECT仅适用于打开的文件，并且必须打开该文件才能使间接更新。
使用morefunc.dll中INDIRECT.EXT之类的功能 - 安装说明here
有人编写了另一个间接函数IndirecEx，它也与INDIRECT.EXT函数相同，但显示了源here：显示的代码以避免链接腐烂：
'Credits:
'- Designed and written by Wilson So.
'- The 'CreateObject("Excel.Application")' trick was inspired by Harlan Grove's PULL function source code.
'------------------------------------
'This is an open source. You can freely redistribute and modify it, but please kindly give credit to the contributers.
'Please also kindly report any bugs/suggestions through e-mail or in the forums where I posted it.
'------------------------------------
'How to use:
'- Basically same as INDIRECT() in Excel - the same concept for the ref_text parameter.
'- To update the static memory for a particular reference,
' type TRUE in the second parameter (just one of the IndirectEx() containing that reference)
' and calculate it once.
'------------------------------------
'Features:
'- You can refer to the closed workbook data.
'- The retrieved closed workbook data will be stored in the static memory,
' so in the next time, the closed workbook will not be opened again for fast retrieve.
'- A range instead of an array will be returned if the path is omitted in the ref_text,
' so it still works fine if the user refers to an enormous array, e.g. "Sheet1!1:65536".
'- You can use it inside INDEX(), VLOOKUP(), MATCH() etc.
'- You can use it with OFFSET(), but only for opened workbook data.
'- The procedure will not blindly retrieve all the data as requested;
' it will not retrieve data beyond the "Ctrl + End" cell, in order to keep the memory as small as possible.
'- #NUM! will be returned in case of lack of memory.
'- #REF! will be returned in case of a wrong path.
'- #VALUE! will be returned in case of other errors.
'------------------------------------
'Known issues:
'- Due to the use of SpecialCells(), #VALUE! will be returned if the worksheet for a closed workbook is protected.
'------------------------------------
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