时间戳

首页 > 解决方案 > VBA在循环时保持工作簿打开

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

问题描述

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

我有这个代码：

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 的信息，但找不到任何具体的内容。

标签： excelvba

解决方案

请尝试按以下方式继续：

  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. 也使用 ne 新参数调用上述Sub代码：
'...your existing code
 TESTReadDataFromAnotherWorkBook r, swb
'... existing code
  1. swb.Close False从它现在所在的位置删除并在之后添加它Next r。

推荐阅读