更新回答
要回答你原來的問題,你必須首先激活該工作簿,然後關閉活動工作簿。 然而,在一個函數中做這件事是非常糟糕的做法,並且很可能以非直觀的方式執行。
以下是修復到原始代碼:
Function GetField(Path As String, WorksheetName As String, CellRange As String) As Variant
'code
wb.Activate 'Activate the opened workbook
ActiveWorkbook.Saved = True
ActiveWorkbook.Close 'Close the active workbook
End Function
執行.Close
內不建議你的函數。
取而代之,爲了實現同樣的目的而不用擔心,請使用Sub
來關閉由您的函數打開的工作簿。我們可以通過執行以下操作來實現:
Sub closeWB(Path As String)
Dim wb As Workbook
Set wb = GetObject(Path)
wb.Activate
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub
然後從您調用函數的相同位置調用它。只要將它的函數調用後..
Sub YourMainSub()
Path = "C:\Users\you\Desktop\file example.xlsm"
something.GetField(Path, "Sheet 1", "A1")
Call closeWB(Path)
End Sub
很多艾倫和我之間的討論後,我們發現了一個解決他的問題。最終在工作表上使用UDF並不能滿足他的需求。因此,我們改變了方向,制定了一個基本上做同樣事情的例程,但沒有工作表功能。這不僅減小了文件大小,而且還使導入數據和設置數據導入的速度顯着加快。下面是一個示例摘錄,以防這個問題的任何人想要第二個可能表現更好的選項。
我可以把數據導入(我們Call DataLoop()
)在它自己的for循環中,但選擇不因維護簡單方便編輯代碼比視覺效率更重要。
'The function that imports the data
Public Function GetField(Path, file, WorksheetName, CellRange) As Variant
Dim wb As Workbook, ws As Worksheet, rng As Range, field As String
If Right(Path, 1) <> "\" Then Path = Path & "\"
If Dir(Path & file) = "" Then
GetField = "File Not Found"
Exit Function
End If
field = "'" & Path & "[" & file & "]" & WorksheetName & "'!" & Range(CellRange).Range("A1").Address(ReferenceStyle:=xlR1C1)
GetField = ExecuteExcel4Macro(field)
End Function
'A loop that calls on the function
Sub DataLoop(DataRange As Range, SourceRow As Long, SourceColumn As Integer, Path, file, WorksheetName)
Dim rcell
For Each rcell In DataRange
rcell.Value = GetField(Path, file, WorksheetName, Cells(SourceRow, SourceColumn).Address(RowAbsolute:=False, ColumnAbsolute:=False))
SourceColumn = SourceColumn + 1
Next rcell
End Sub
'The main routine where we define where data goes and comes from
Sub DataEntry()
Dim dataWS As Worksheet, Path1 As String, WsName1 As String
Dim testFileName As Range, file
Dim avgDmmV As Range, avgPSTATADCV As Range, ppPSTATADCV As Range
Dim gainLO0A As Range, gainLO0B As Range, gainLOm10A As Range, gainLOm10B As Range
Dim gainLO10A As Range, gainLO10B As Range, gainLO20A As Range, gainLO20B As Range
Dim gainLO60A As Range, gainLO60B As Range
Set dataWS = ThisWorkbook.Sheets("DATA")
Path1 = "\\server5\Operations\MainBoard testing central location DO NOT REMOVE or RENAME" 'File path Location
WsName1 = "Summary"
'The values of the cells in this range have the names of the .xls files
Set testFileName = dataWS.Range("A6", dataWS.Range("A6").End(xlDown))
For Each file In testFileName 'Loop through each file name
dataRow = file.Row
Set avgDmmV = dataWS.Range("C" & dataRow & ":F" & dataRow)
Set avgPSTATADCV = dataWS.Range("H" & dataRow & ":M" & dataRow)
Set ppPSTATADCV = dataWS.Range("Q" & dataRow & ":W" & dataRow)
Set gainLO0A = dataWS.Range("Y" & dataRow & ":AG" & dataRow)
Set gainLO0B = dataWS.Range("AI" & dataRow & ":AQ" & dataRow)
Set gainLOm10A = dataWS.Range("AS" & dataRow & ":BA" & dataRow)
Set gainLOm10B = dataWS.Range("BC" & dataRow & ":BK" & dataRow)
Set gainLO10A = dataWS.Range("BM" & dataRow & ":BU" & dataRow)
Set gainLO10B = dataWS.Range("BW" & dataRow & ":CE" & dataRow)
Set gainLO20A = dataWS.Range("CG" & dataRow & ":CO" & dataRow)
Set gainLO20B = dataWS.Range("CQ" & dataRow & ":CY" & dataRow)
Set gainLO60A = dataWS.Range("DA" & dataRow & ":DI" & dataRow)
Set gainLO60B = dataWS.Range("DK" & dataRow & ":DS" & dataRow)
Call DataLoop(avgDmmV, 9, 5, Path1, CStr(file.Value), WsName1)
Call DataLoop(avgPSTATADCV, 15, 5, Path1, CStr(file.Value), WsName1)
Call DataLoop(ppPSTATADCV, 18, 5, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO0A, 31, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO0B, 32, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLOm10A, 33, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLOm10B, 34, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO10A, 35, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO10B, 36, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO20A, 37, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO20B, 38, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO60A, 39, 3, Path1, CStr(file.Value), WsName1)
Call DataLoop(gainLO60B, 40, 3, Path1, CStr(file.Value), WsName1)
Next file
End Sub
您正在嘗試使用'Function',但在其中有'Application.Quit'。我不確定你是否可以這樣做。相反,把它變成一個'Sub'(你將不得不爲那些正在傳遞的變量創建變量),看看它是否有效。 – BruceWayne
你永遠不會告訴它什麼工作簿關閉。 –
@DougCoats,我也試過了。關閉 其中wb = GetObject(Path)或 GetObject(Path).Close SaveChanges:= True – Allan