Excel .发现vba运行缓慢

Excel .发现vba运行缓慢,excel,vba,Excel,Vba,基本上,我需要循环1566行,并对每行执行一个.find,并与10691行进行比较。问题是,为了获得搜索值,我将三个值连接在一起。它的工作速度非常慢,所以我尝试通过10691上的第一个值进行过滤,这样它的工作速度会更快——但没有乐趣!我正在使用几个函数,字母检索列的字母 Option Explicit Sub validate() Dim gbe As Worksheet, mp As Worksheet, PnS As Worksheet Dim rng As Range, Frng As

基本上,我需要循环1566行,并对每行执行一个.find,并与10691行进行比较。问题是,为了获得搜索值,我将三个值连接在一起。它的工作速度非常慢,所以我尝试通过10691上的第一个值进行过滤,这样它的工作速度会更快——但没有乐趣!我正在使用几个函数,字母检索列的字母

Option Explicit

Sub validate()
Dim gbe As Worksheet, mp As Worksheet, PnS As Worksheet
Dim rng As Range, Frng As Range
Dim ITC, TT, BC, y, GCell, sz, t, vList

t = Timer
OptimizeVBA True
ShDel ("Garbage"): Sheets.Add.name = "Garbage": Set gbe = Sheets("Garbage"): Set mp = Sheets("Master"): Set PnS = Sheets("PS")


    ITC = Letter(PnS, "Code"): TT = Letter(PnS, "Type"): BC = Letter(PnS, "BCode")
    mp.Range("M2:O" & mp.Range("A1").SpecialCells(xlCellTypeLastCell).Row).ClearContents
    PnS.Range((ITC & ":" & ITC & "," & TT & ":" & TT & "," & BC & ":" & BC)).Copy Destination:=gbe.Range("A1")
    gbe.Range("$A$1:$C$" & PnS.Range("A1").SpecialCells(xlCellTypeLastCell).Row).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes

        gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter
        gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter Field:=1, Criteria1:="='", _
            Operator:=xlOr, Criteria2:="='FC"
        gbe.rows("2:" & gbe.Range("A1").End(xlDown).Row).EntireRow.Delete
        gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter

        Set rng = gbe.Range("A2:A" & gbe.Range("A1").SpecialCells(xlCellTypeLastCell).Row)
        For Each y In rng
        mp.Range("A1:K" & gbe.Range("A1").End(xlDown).Row).AutoFilter Field:=3, Criteria1:="=" & y
        With mp.Range("A2:A" & mp.Range("A1").SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
        Set GCell = .Find(What:=sz, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True)
            If GCell Is Nothing Then
                mp.Range("O100000").End(xlUp) = PnS.Range(ITC & y.Row)
                mp.Range("O100000").End(xlUp).Offset(0, 1) = PnS.Range(TT & y.Row)
                mp.Range("O100000").End(xlUp).Offset(0, 2) = PnS.Range(BC & y.Row)
            End If
            Set GCell = Nothing
            mp.ShowAllData
        End With

        Next y

    ShDel ("Garbage")

OptimizeVBA False
MsgBox Timer - t

End Sub

在excel工作表上执行操作的常见建议是在执行代码时以编程方式停用某些设置

以下是我在许多项目中使用的一个小片段:

Public Sub ExcelDefaultSettings(ByVal isActive As Boolean)

    With Application
        .ScreenUpdating = isActive
        .DisplayAlerts = isActive
        If isActive Then
            .Calculation = xlCalculationAutomatic
        Else
            .Calculation = xlCalculationManual
        End If
    End With

End Sub
然后,在执行之前和之后,您只需执行以下两个调用:

ExcelDefaultSettings isActive:=False  'Before

ExcelDefaultSettings isActive:=True  'After
这不是一个完美的解决方案,但它可以在更大的项目上发挥巨大的作用

正如@Kyle和@Ralph所说,重构代码也有助于提高执行速度

另一个常见的建议是:1)将范围的内容转置到数组中,2)仅对数组执行操作,然后3)将数组转置回范围中

这比添加一点代码要复杂一些,但是可以找到一个很好的解释

这是他们给出的基本循环示例:

Dim Arr() As Variant
Arr = Range("A1:B10")
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
    For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
        Debug.Print Arr(R, C)
    Next C
Next R

.Find
的速度非常慢。将你的范围拉到一个变量数组中,循环搜索你的值,并进行你正在寻找的连接。我还建议使用“
”搜索“
”,以“
结束”,以帮助你的代码更容易被人看到。我支持@Kyle提供的建议。在内存中执行所有这些任务(而不是直接在工作表中执行)将极大地提高性能。但是,我相信,如果你愿意在正确的网站上发布这个问题,你会得到更多有用的见解:基本上就是他们帮助你提高工作/现有代码的速度、安全性、可维护性和寿命的网站。谢谢@Den Temple,函数OptimizeVBA True关闭所有会降低Excel速度的设置。就数组而言,数组中仍然会有大约1600个值,我所做的是创建一个虚拟表,复制两个具有识别特征的列,并删除单元格之间的重复项,粗糙但快速。谢谢你的代码!