【发布时间】：2017-06-20 02:12:05
【问题描述】：
所以我有一个主工作簿（我们将其称为 Workbook One），它需要从一系列其他工作簿中提取单个单元格的数据，通常以百分比形式，并将其存放在列中单击一个按钮。另一个工作簿的路径在工作簿一中列出。然而，路径是动态构建的。因此，工作簿名称是根据单元格 A1 中的输入构建的：=A1 和“.xlsx”，驱动器和文件夹路径如下所示：=N1 和 N2 和 N3 等，视文件夹和驱动器的数量而定姓名。这一切都进入一个读取完整路径的单元格，但如果有必要，我可以（并且已经）单独提取零碎。
我的最终目标是通过一个按钮激活一个宏，该按钮贯穿工作簿列表，从每个工作簿中提取一个单元格中的数据并将其存放在 Workbook One 的一系列单元格中。此外，该列表可能包含空白，因此如果可能，请跳过空白单元格。另外，我对这段代码不感兴趣，所以如果你有更好的方法，请告诉我。
目前我的代码如下所示：
Function dynamicPull()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim sourceRange As Integer, inputRow As Integer, fepTotal As Integer
fepTotal = Range("EventList!F2").Value 'total number of events to run through
sourceRange = 2
inputRow = 3
Dim sourceFile As String, inputRange As String, pullRange As String, pullData As String
sourceFile = Range("Settings!Q" & sourceRange).Value 'currently unused
pullRange = Range("Settings!$N$23").Value 'cell to pull from in series of workbooks
Dim wbSource As Workbook, wbMain As Workbook
Set wbMain = ThisWorkbook
Dim sourceFile1 As String, sourceFile2 As String, sourceFile3 As String
sourceFile1 = Range("Settings!$N$26").Value 'pathing to workbook, ie C:\Folder1\Folder2\
sourceFile2 = Range("Settings!R" & sourceRange).Value 'workbook name
sourceFile3 = "Cover Sheet" 'sheet name
If fepTotal >= 1 Then
checkedEvents = 0 'checkedEvents is dimmed in declarations
error = 0
For pullLoop = 1 To fepTotal
sourceRange = 2
inputRow = 3
inputRange = "D" & inputRow 'where i want the pulled data to go
sourceFile2 = Range("Settings!R" & sourceRange).Value 'workbook name
pullData = GetValue(sourceFile1, sourceFile2, sourceFile3, pullRange)
If pullData = "FnF" Then
'wbMain.Sheets("EventList").Range(inputRange).Value = "FnF"
GoTo FnF
Else
wbMain.Sheets("EventList").Range(inputRange).Value = pullData
checkedEvents = checkedEvents + 1
End If
FnF:
inputRow = inputRow + 1 'shifts to next input cell (D4, D5, etc)
sourceRange = sourceRange + 1 'shifts to next cell containing next document pathing
Next pullLoop
Else
error = MsgBox("No event inputs to derive from.", vbCritical, "ERROR")
error = 1
End If
sourceRange = 2 'resets sourceRange to first pull cell
inputRow = 3
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Function
'Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
' Dim arg As String
' Make sure the file exists
' If Right(path, 1) <> "\" Then path = path & "\"
' If Dir(path & file) = "" Then
' GetValue = "FnF"
' Exit Function
' End If
' Create the argument
' arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
' Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
' GetValue = ExecuteExcel4Macro(arg)
'End Function
Function GetValue(ByVal sPath As String, sFile As String, _
sSht As String, sRng As String) As Variant
' Retrieves a value from a closed workbook
' VBA only
Dim sArg As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
If Len(Dir(sPath & sFile)) Then 'Runtime error 52: Bad file name or number
sArg = "'" & sPath & _
"[" & sFile & "]" & _
sSht & "'!" & _
Application.ConvertFormula(sRng, xlA1, xlR1C1, True)
GetValue = ExecuteExcel4Macro(sArg)
Else
GetValue = "File not found"
End If
End Function
我发现了其他几篇可能有用的帖子：
Pulling from closed workbook - Stack overflow
GetValue function - The Spreadsheet Page
我已经为此苦苦挣扎了很长一段时间，非常感谢任何和所有帮助。我会尽快回答任何问题，提供任何反馈等。再次感谢。
【问题讨论】：
-
在每本工作簿中是否包含带有标题的表格，如果有，它们是否都不同？您必须找到每个工作簿的静态差异。之后就很容易区分它们了。
-
您能具体说明问题所在吗？您的代码是否正常工作，但没有给出预期的结果？出现错误？
-
@Quint 我从中拉出的系列工作簿，我只想拉出封面上的单元格K15。 “Cover Sheet”被 sourceFile3 覆盖，而单元格 K15 被 pullRange 覆盖。
-
在出错的那一行放一个断点，然后检查
sPath和sFile的值——其中一个显然是无效的。 -
单击要停止的行，然后按 F9。该线将变为红色，表示一个断点。程序将在该行暂停，您可以检查您的变量。