VBA - 获取必要信息后关闭工作簿

Question

解决这个世界(Excel VBA)问题需要您的帮助。
我正在使用 VBA 从一桶工作簿(数量 = 96)中填充一个巨大的工作簿(每行 500 个单元格)。
我使用的 VBA 由 [@Kevin][1] 创建，它适用于大约 20 个文件，直到我的电脑内存不足并导致 Excel 崩溃。
这种方法非常适合在每个工作簿中处理如此大量的单元格，因为打开和关闭每个工作簿会增加相当多的过程。打开每个工作簿并复制所有 500 个单元格并关闭，然后继续下一个单元格，依此类推 x ±96 次，但这比仅使这一个工作更复杂，如果您有 2 个解决方案中的任何一个，请帮忙!

这是我正在使用的 VBA:

Function GetField(Path As String, WorksheetName As String, CellRange As String) As Variant

Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range

Set wb = GetObject(Path)
Set ws = wb.Worksheets(WorksheetName)
Set rng = ws.Range(CellRange)

GetField = rng.Value

wb.close 

End Function

Answer 1

更新答案

要回答您的原始问题，您必须先激活工作簿，然后关闭事件工作簿。 但是，在函数中执行此操作是非常糟糕的做法，并且很可能会以非直观的方式执行。

以下是对原始代码的修复:

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