使 VBA 项目运行更有效率

Question

我是 VBA 中的一名非常新的编码员（一般而言）。我设法写了一些代码来检查一个坐标文件，其值在Excelsheet中，并使用坐标来验证相关文件坐标位置（坐标文件指定的范围）中的值.我的问题是有超过 10000 行要检查，涉及超过 100 个 Excel 个文件。

宏的运行时间超过2小时

我曾尝试关闭屏幕更新等，以使其更快，但似乎没有太大帮助。

谁能建议我怎样才能更有效地运行？

主要代码

Sub Output_varification()
 
'input folder path for the Axiom output
 
Dim Folderpath As String
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            Folderpath = .SelectedItems(1) & "\"
        End If
    End With
       
    
    If Folderpath <> "" Then
    'MsgBox Folderpath
   
    Else
    MsgBox "no folder chosen"
   
    End If
 
'find the starting point of the output file
 
Dim Start As Range
 
Dim choice As Variant
 
choice = MsgBox("Do you want to start from scratch?", vbYesNo, "Starting point")
 
If choice = 7 Then
 
    Set Start = Application.InputBox("choose the template line on template number cell (should be column B)", "Input", Type:=8)
'MsgBox Start.Value
 
Else
Set Start = ActiveSheet.Range("A:F").Find(what:="Template", LookIn:=xlValues)
 
End If
 
Application.ScreenUpdating = False
 
While Start.Offset(1, 0).Value <> ""
   
    Call Reading_Coordinates(Start.Offset(1, 0), Folderpath)
   
    Set Start = Start.Offset(1, 0)
 
Wend
 
Application.ScreenUpdating = True
 
MsgBox "Task complete!"
 
End Sub

子函数 1

Private Sub Reading_Coordinates(Line As Range, File As String)
 
'Line As Range, File As String
 
Dim Filepath As String
Dim ctemplate As Workbook
 
Dim Temp_number As String
Dim Sheet_number As String
Dim Row_number As String
Dim Column_number As String
Dim Amount As Variant
 
'test
'Set Line = Range("b2")
'File = "\fwlnp006vf.ln.fw.gs.com\zjunli\home\Desktop\Template Hub project\Axiom output\GSI output\"
'MsgBox File
 
'Read data in one line in Axiom output
 
If Temp_number <> Line.Value Then
 
    Temp_number = Line.Value
    Sheet_number = Line.Offset(0, 1).Value
    Row_number = Line.Offset(0, 2).Value
    Column_number = Line.Offset(0, 3).Value
    Amount = Line.Offset(0, 4).Value
   
    'MsgBox Temp_number & Sheet_number & Row_number & Column_number & Amount
   
    'open the file with the template number
    'Note wonn't work for template more than 1 part
   
    If Temp_number <> "F_40_0*" Then
   
        Filepath = Dir(File & "*" & Temp_number & "*.xlsx")
       
        'MsgBox Filepath
        On Error Resume Next
        Set ctemplate = Workbooks.Open(File & Filepath)
       
            Call Get_Cell(Row_number, Column_number, Filepath)
            If Get_Cell(Row_number, Column_number, Filepath).Value <> Amount Then
                Line.Offset(0, 4).Interior.Color = 65535
                Line.Offset(0, 5).Value = Get_Cell(Row_number, Column_number, Filepath).Value
            End If
           
            Workbooks(Filepath).Close (False)
   
    End If
  
Else
    Sheet_number = Line.Offset(0, 1).Value
    Row_number = Line.Offset(0, 2).Value
    Column_number = Line.Offset(0, 3).Value
    Amount = Line.Offset(0, 4).Value
       
          Call Get_Cell(Row_number, Column_number, Filepath)
            If Get_Cell(Row_number, Column_number, Filepath).Value <> Amount Then
                Line.Offset(0, 4).Interior.Color = 65535
                Line.Offset(0, 5).Value = Get_Cell(Row_number, Column_number, Filepath).Value
            End If
   
End If
 
End Sub

子功能2

Private Function Get_Cell(xrow As String, xcolumn As String, ftemplate As String) As Range
 
Dim findrow As Range
Dim findcolumn As Range
 
Set findrow = Workbooks(ftemplate).Worksheets(1).Range("C:C").Find(what:=xrow, LookIn:=xlValues)
Set findcolumn = Workbooks(ftemplate).Worksheets(1).Range("D:AZ").Find(what:=xcolumn, LookIn:=xlValues)
 
Set Get_Cell = Cells(findrow.row, findcolumn.column)
 
End Function

Answer 1

尝试消除 iF，并尝试在代码中插入 scapes，使用类似“if 1=1 then goto continue”并在循环外插入 continue。

Answer 2

未经测试，但这里有一些想法：

Re-use already-opened 文件是同一来源。您的代码并没有完全做到这一点，因为 Temp_number （以及其他）在调用之间被擦除
将主循环移至Reading_Coordinates
将查找功能移至主子


'call with Line = first cell to process
Private Sub Reading_Coordinates(Line As Range, File As String)
 
    Dim ctemplate As Workbook
    Dim Temp_number As String
    Dim Sheet_number As String
    Dim Row_number As String
    Dim Column_number As String
    Dim Amount As Variant, v, f, m, amt, findcolumn As Range
   
    'main loop is now here   
    Do While Len(Line.Value) > 0
        
        v = Line.Value
        
        If Temp_number <> v Then 'new source file?
            If Not ctemplate Is Nothing Then ctemplate.Close False 'close previous
            If Not v Like "F_40_0*" Then
                f = Dir(File & "*" & v & "*.xlsx")
                If Len(f) > 0 Then
                    Set ctemplate = Workbooks.Open(File & f, ReadOnly:=True)
                End If
            End If
            Temp_number = v
        End If
        
        If Not ctemplate Is Nothing Then
            
            Sheet_number = Line.Offset(0, 1).Value
            Row_number = Line.Offset(0, 2).Value
            Column_number = Line.Offset(0, 3).Value
            Amount = Line.Offset(0, 4).Value
            
            With ctemplate.Worksheets(1)
                m = Application.Match(Row_number, .Columns("C"), 0) 'match is faster...
                If Not IsError(m) Then
                    Set findcolumn = .Range("D:AZ").Find(what:=Column_number, LookIn:=xlValues)
                    If Not findcolumn Is Nothing Then 'Find got a match
                        amt = .Cells(m, findcolumn.Column).Value
                        If amt <> Amount Then
                            Line.Offset(0, 4).Interior.Color = 65535
                            Line.Offset(0, 5).Value = amt
                        End If
                    End If
                End If 'got a col C match
            End With
            
        End If 'have a file to look at
        
        Set Line = Line.Offset(1, 0) 'next cell
    Loop
End Sub

使 VBA 项目运行更有效率

Make VBA project run more efficient

excel

performance

vba

processing-efficiency

主要代码

子函数 1

子功能2

使 VBA 项目 运行 更有效率

Make VBA project run more efficient

excel

performance

vba

processing-efficiency

主要代码

子函数 1

子功能2

使 VBA 项目运行更有效率