首页 > 解决方案 > 对于每个新循环,for 循环都会变慢

问题描述

我构建了一个加载项,将描述与不同文档中的单词列表库相匹配。

我的循环一遍又一遍地做同样的事情,但是一个循环只需要一秒钟多一点的时间来完成,其中 10 次迭代大约需要 3 秒,20 次循环平均需要 4 秒,但 200 次需要几个小时才能完成。

代码片段:

For Each rRow In CoAsh.Range(matchRange.Address).Rows
    pctDone = i / rowCount

    With frmProgress
        .LabelCaption.Caption = "Processing account " & i & " of " & rowCount
        .LabelProgress.Width = pctDone * (.FrameProgress.Width)
        .LabelPercent = Round(pctDone * 100, 0) & "%"
    End With
    DoEvents

    accArray = sh.Range("A2:A" & lRow).Value

    For b = LBound(accArray) To UBound(accArray)
        accString = accArray(b, 1)
        sh.Cells(b + 1, 3).Value = levenshtein(CoAsh.Cells(rRow.Row, AccCol), accString, True)
    Next b

    sh.Select
    sh.AutoFilter.Sort.SortFields.Clear
    sh.AutoFilter.Sort.SortFields.Add Key:=Range("C1:C" & lRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With sh.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    sh.Range("B2:B6").Copy
    sh.Range("I2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    sh.Range("$I$2:$I$6").RemoveDuplicates Columns:=1, Header:=xlNo
    sh.Range("I2:I6").Copy
    CoAsh.Select
    CoAsh.Cells(rRow.Row, 8).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    i = i + 1

Next rRow

标签: excelvba

解决方案


推荐阅读