VBA在循环时保持工作簿打开

Question

我想知道是否有办法在检查每个数字后（循环结束后）保持工作簿打开和关闭。

我有这个代码：

Sub TESTReadDataFromAnotherWorkBook(ActCell As Range)       

    Dim sFound As String
    Dim swb As Workbook

    sFound = Dir(ActiveWorkbook.Path & "\test\" & "FileINeed_*")    
    If sFound <> "" Then
       Set swb = Workbooks.Open(ActiveWorkbook.Path & "\test\" & sFound, True, True)
       Debug.Print "FOUND IN DIR: " & sFound
    End If
    
    Debug.Print "Processing workbook '" & swb.Name & "'..."
    
    Dim sString As String: sString = ActCell.Value                                
    
    Debug.Print "Searching for '" & sString & "'..."
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim sCell As Range
    Dim fAddress As String
    
    Dim tnFound As Boolean
    tnFound = False
    
    Dim notChangedBool As Boolean                                                          
    notChangedBool = False
    
    swb.Windows(1).Visible = False                    ' Reduces flickering - speeds up the process     
    Application.ScreenUpdating = False
    
    For Each sws In swb.Worksheets
     If ((sws.Name = "Test1") Or (sws.Name = "Test2") Or (sws.Name = "Test3")) Then                  ' Only look into the 3 Sheets
        Debug.Print "Processing worksheet '" & sws.Name & "'..."
        Set srg = sws.UsedRange
        Set sCell = srg.Find(What:=sString, _
            After:=srg.Cells(srg.Rows.Count, srg.Columns.Count), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows)
        If Not sCell Is Nothing Then
            fAddress = sCell.Address
            Do
                Debug.Print "Found string in '" & sCell.Address(0, 0) _
                    & "'. The value in " & sCell.Offset(, 1).Address(0, 0) _
                    & " is " & sCell.Offset(, 1).Value
                Set sCell = srg.FindNext(sCell)
                tnFound = True
            Loop Until sCell.Address = fAddress
            
            
            If (ActCell.Offset(, 14).Value = 3) Then                                                    
                Debug.Print "Value is 3"
                notChangedBool = True
                  
            
            ElseIf (sCell.Offset(, 1).Value = "-" And notChangedBool = False) Then                                     
                Debug.Print sCell.Offset(, 1).Value
                Debug.Print "ActiveCell? : " & ActCell.Address
                ActCell.Offset(, 14).Value = 0
                                                                                                     
            ElseIf (sCell.Offset(, 1).Value <> "-" And notChangedBool = False) Then
                Debug.Print sCell.Offset(, 1).Value
                ActCell.Offset(, 14).Value = 2
                
            End If
            
        End If
        
        End If
        
    Next
    swb.Close False

End Sub

此代码的作用是打开一个工作簿并循环抛出 3 张具有特定名称的工作表。如果在 Excel 中找到传递的包含数字的 ActCell，则它将 2 作为执行宏的 Excel 中的值写入。如果不是，它会写一个 0。

问题是：我如何传递一个范围，打开工作簿一次，运行每个范围对象的代码，然后关闭工作簿。重要的是该函数仍然像以前一样工作，因为如果它找到 Number(ActCell)，它应该修改 ActiveCells.Offset 值。

这是我获取 Range 对象的方式，我目前正在循环中运行它，这意味着它会为每个数字再次调用函数并因此打开和关闭工作簿。

Private Sub CommandButton3_Click()                                                          

Dim searchRng As Range: Set searchRng = Range("A9:A5000")                                  
Dim r As Range

Dim StartTime As Double

Dim answer As Variant

    answer = MsgBox("Warning this could take some time..", vbOKCancel)
    
    If (answer = vbOK) Then
    
    StartTime = Timer
    
    For Each r In searchRng                                                         ' Loop threw Numbers that are not empty
        
        If (r.Value <> "") Then
            Debug.Print r                                                           'prints the Numbers that are searched         
            TESTReadDataFromAnotherWorkBook r                                    
      
        End If
        
    Next r
    
    MsgBox ("Done" & " || Runtime: " & Format((Timer - StartTime) / 86400, "hh:mm:ss"))
    
   End If

End Sub

这里的问题是我对 3 个函数做了同样的事情。但是他们打开的 Excel 很小 - 这意味着它发生得非常快。

对于顶部提到的函数，打开的 Excel 非常大......因此我的运行时间很慢。

比较：运行其他 3 个函数（基本上相同的函数但打开不同的 Excel）：运行时间 1:25 分钟

运行打开大型 Excel 的 1 函数：运行时间 10:00 分钟

所以我想保持 Excel 打开，这样它就不必一直关闭并重新打开它，因为这需要大部分时间。

我已阅读有关 getObject() 和 Excel Jet 的信息，但找不到任何具体内容。

Answer 1

请尝试以下方法：

1. 将下一个代码部分移到“CommandButton3_Click()”子的开头：

    Dim sFound As String
    Dim swb As Workbook

    sFound = Dir(ActiveWorkbook.Path & "\test\" & "FileINeed_*")    
    If sFound <> "" Then
       Set swb = Workbooks.Open(ActiveWorkbook.Path & "\test\" & sFound, True, True)
       Debug.Print "FOUND IN DIR: " & sFound
    End If
    
    Debug.Print "Processing workbook '" & swb.Name & "'..."

1. 将新参数添加到“TESTReadDataFromAnotherWorkBook”Sub：

Sub TESTReadDataFromAnotherWorkBook(ActCell As Range, swb As Workbook)  

1. 也调用上面的Sub 新参数：

'...your existing code
 TESTReadDataFromAnotherWorkBook r, swb
'... existing code

4. 从现在的位置删除swb.Close False，并将其添加到Next r 之后。

Answer 2

您需要将打开和关闭操作移动到更高级别的子程序中，然后将工作簿名称向下传递。一个非常删节的版本是：

Private Sub CommandButton3_Click()   

    Set swb = Workbooks.Open(ActiveWorkbook.Path & "\test\" & sFound, True, True)

    for each r in 
        call TESTReadDataFromAnotherWorkBook(r, swb)
    next r

    swb.Close False


end sub



Sub TESTReadDataFromAnotherWorkBook(ActCell As Range, swb as workbook)
   'stuff here

end sub

如果工作簿中有公式并且您确定它们确实不需要需要更新，您可以打开 application.calculation = xlCalculationManual 以在打开时停止运行，但这很可能是仅增量保存。