VBA - 获取必要信息后关闭工作簿 [英] VBA - Close workbook after acquiring necessary information

问题描述

您需要帮助才能解决这个世界（Excel VBA）问题。
我正在使用一个VBA来填充庞大的工作簿（每行500个单元格），从一桶载入的工作簿（数量= 96）。
我正在使用的VBA由[@Kevin] [1]创建，它可以工作大约20个文件，直到我的电脑耗尽内存并崩溃了Excel。
这种工作非常适合每个工作簿使用这么大量的单元格，因为打开和关闭每个工作簿会增加相当多的过程。打开每个工作簿并复制所有500个单元格并关闭，然后继续下一个等级x±96次，但是比起这个工作更复杂，如果您有任何2个解决方案，请帮助！

这是我使用的VBA：

 code>函数GetField（Path As String，WorksheetName As String，CellRange As String）As Variant 
 
 Dim wb As Workbook 
 Dim ws As Worksheet 
 Dim rng As Range 
 
设置wb = GetObject（Path）
设置ws = wb.Worksheets（WorksheetName）
设置rng = ws.Range（CellRange）
 
 GetField = rng.Value 
 
 wb.close 
 
结束函数
  

解决方案

更新答案

要回答您的原始问题，您必须激活工作簿首先关闭活动工作簿。 到您的原始代码：

 函数GetField（Path As String，WorksheetName As String，CellRange As String）As Variant 
 
'代码
 
 wb.Activate'激活打开的工作簿
 ActiveWorkbook.Saved = True 
 ActiveWorkbook.Close'关闭活动工作簿
 
结束功能
  

执行。关闭在你的函数内不建议。

相反，为了实现同样的事情，不用担心，做一个 Sub 关闭您的功能打开的工作簿。我们可以通过执行以下操作来实现这一点：

  Sub closeWB（Path As String）
 Dim wb As Workbook 
设置wb = GetObject（路径）
 wb.Activate 
 ActiveWorkbook.Saved = True 
 ActiveWorkbook.Close 
 End Sub 
  / pre> 
 
 
然后从您调用函数的同一个地方调用它。只需将其放在函数调用后。
  Sub YourMainSub（）
 Path =C：\Users\\ \\ you \Desktop\file example.xlsm
 something.GetField（Path，Sheet 1，A1）
调用closeWB（Path）
 End Sub 
在Allan和I之间进行了大量的讨论之后，我们发现了一个解决他的问题的解决方案。最终在工作表上使用UDF无法满足他的需求。因此，我们改变了方向，做了一个例行程序，基本上做了同样的事情，但没有工作表功能。这不仅减少了文件大小，而且导入数据和数据导入设置明显更快。以下是一个示例摘录，如果有同样问题的人想要第二个可能会更好的选项。 
 
 
 
我可以把数据导入（Where我们调用DataLoop（））在它自己的For循环中，但选择不是因为维护一个简单易于编辑的代码比视觉效率更重要。
 '导入数据的函数
公共函数GetField（Path，file，WorksheetName，CellRange）As Variant 
 Dim wb As Workbook，ws As Worksheet，rng As Range，field As String 
 
如果Right（Path，1）<> \Then Path = Path& \
 
如果Dir（Path& file）=然后
 GetField =找不到文件
退出函数
结束If 
 
 field ='&路径& [&档案& ]& WorksheetName& ！ &安培;范围（CellRange）.Range（A1）。地址（ReferenceStyle：= xlR1C1）
 GetField = ExecuteExcel4Macro（field）
结束函数
 
'函数
 Sub DataLoop（DataRange As Range，SourceRow As Long，SourceColumn As Integer，Path，file，WorksheetName）
 Dim rcell 
 
对于每个rcell在DataRange中
 rcell .Value = GetField（Path，file，WorksheetName，Cells（SourceRow，SourceColumn）.Address（RowAbsolute：= False，ColumnAbsolute：= False））
 SourceColumn = SourceColumn + 1 
下一个rcell 
 End Sub 
 
'我们定义数据来源于
的主程序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 rangeLOm10B As Range 
 Dim gainLO10A As Range，gainLO 10B As Range，gainLO20A As Range，gainLO20B As Range 
 Dim gainLO60A As Range，gainLO60B As Range 
 
设置dataWS = ThisWorkbook.Sheets（DATA）
 Path1 =\\ \\\server5\Operations\MainBoard测试中央位置不要删除或重命名'文件路径位置
 WsName1 =摘要
 
'此范围中的单元格的值具有.xls文件的名称
设置testFileName = dataWS.Range（A6，dataWS.Range（A6）。End（xlDown））
 
对于每个文件在testFileName'循环遍历每个文件名
 dataRow = file.Row 
 
设置avgDmmV = dataWS.Range（C& dataRow& ：F& dataRow）
设置avgPSTATADCV = dataWS.Range（H& dataRow&M& dataRow）
设置ppPSTATADCV = dataWS.Range（Q& dataRow&： W& dataRow）
 
设置gainLO0A = dataWS.Range（Y& dataRow&：AG& dataRow）
设置gainLO0B = dataWS.Range & dataRow&：AQ& dataRow）
设置gainLOm10A = dataWS.Range（AS& dataRow&：BA& dataRow）
设置gainLOm10B = dataWS。范围（BC& dataRow&BK& dataRow）
设置gainLO10A = dataWS.Range（BM& dataRow&BU& dataRow）
设置gainLO10B = dataWS.Range（BW& dataRow&：CE& dataRow）
设置gainLO20A = dataWS.Range（CG& dataRow&：CO& dataRow）
设置gainLO20B = dataWS.Range（CQ& dataRow&CY& dataRow）
设置gainLO60A = dataWS.Range（DA& dataRow&：DI& ; dataRow）
设置gainLO60B = dataWS.Range（DK& dataRow& DS& dataRow）
 
调用DataLoop（avgDmmV，9,5，Path1，CStr（file.Value），WsName1）
调用DataLoop（avgPSTATADCV，15,5，Path1，CStr（file.Value ），WsName1）
调用DataLoop（ppPSTATADCV，18,5，Path1，CStr（file.Value），WsName1）
 
调用DataLoop（gainLO0A，31，3，Path1，CStr调用DataLoop（gainLOm10A，33，3，Path1，CStr（file.Value）），调用DataLoop ），WsName1）
调用DataLoop（gainLOm10B，34,3，Path1，CStr（file.Value），WsName1）
调用DataLoop（gainLO10A，35,3，Path1，CStr（file.Value） WsName1）
调用DataLoop（gainLO10B，36,3，Path1，CStr（file.Value），WsName1）
调用DataLoop（gainLO20A，37,3，Path1，CStr（file.Value），WsName1） 
调用DataLoop（gainLO20B，38,3，Path1，CStr（file.Value），WsName1）
调用DataLoop（gainLO60A，39，3，Path1，CStr（file.Value），WsName1）
调用DataLoop（ga inLO60B，40,3，Path1，CStr（file.Value），WsName1）
下一个文件
 End Sub 
  
 
Your assistance is required on solving this world (Excel VBA) problem.
I am using a VBA to populate an immense workbook (500 Cells per row), from a bucket load of workbooks(Qty=96).
The VBA I am using got created by [@Kevin][1] and it works for about 20 files until my pc runs out of memory and crashes Excel.
This kind of works great for working with such an immense amount of cells per workbook, because opening and closing each workbook adds up to the process quite a lot. Opening each work book and copy all 500 cells and close, then proceed with the next one and so on x ±96 times, but that would be more complicated than just making this one work, if you have any of the 2 solutions please help! 

Here is the VBA I am using:
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

解决方案
Updated Answer 

To answer your original question, you have to activate the workbook first, then close the active workbook. However, doing this in a function is very poor practice and will more than likely perform in non-intuitive ways.

The following is the fix to your original code:
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
Performing the .Close inside your function is not advised.

Instead, to achieve the same thing without worry, make a Sub to close the workbooks that are opened by your function. We can achieve this by doing the following:
Sub closeWB(Path As String)
    Dim wb As Workbook
    Set wb = GetObject(Path)
    wb.Activate
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
End Sub
And then call on it from the same place you're calling your function. Just place it after the function call..
Sub YourMainSub()
    Path = "C:\Users\you\Desktop\file example.xlsm"
    something.GetField(Path, "Sheet 1", "A1")
    Call closeWB(Path)
End Sub
After a lot of discussion between Allan and I, we discovered a solution to his problem. Ultimately using a UDF on the worksheet wasn't meeting his needs. As such we changed directions and made a routine that essentially did the same thing, but without having worksheet functions. This not only reduced the file size, but also made importing the data and setting up for the data import significantly faster. Below is a sample excerpt, in case anyone with this same issue wants a second option that may perform better.

I could have put the data importing (Where we Call DataLoop()) in it's own For loop, but chose not to because maintaining a simple easy to edit code was more important than visual efficiency.
'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


                        
这篇关于VBA  - 获取必要信息后关闭工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！