时间戳

首页 > 解决方案 > 通过 VBA 加快在多个工作表中查找出现的速度

excel - 通过 VBA 加快在多个工作表中查找出现的速度

问题描述

使用下面的代码，我可以找到联系了多少次。为此，该公式使用命名范围（周）并在多个工作表中搜索合作伙伴名称。

我没有使用简单的公式，因为文件的变化取决于使用文件的人，所以我使用的是 VBA。

虽然下面的代码有效，但这很慢，我想知道是否有人可以帮助我加快速度，或者可以建议我其他方法来获得相同的结果。

Sub ContactCycle()

Dim WsMaster As Worksheet
Dim WsLastRow As Long
Dim MyContactCycleRange As Range, cell As Range

Set WsMaster = ThisWorkbook.Worksheets("Master")
WsLastRow = WsMaster.Range("A" & Rows.Count).End(xlUp).Row

Set MyContactCycleRange = WsMaster.Range("AB5:AB" & WsLastRow)
Application.EnableEvents = False
For Each cell In MyContactCycleRange
cell.Formula = "=IF(SUMPRODUCT(COUNTIF(INDIRECT(""'""&Weeks&""'!""&""$A$6:$A$45""),$B5))>0,1,0)"
Next cell
Application.EnableEvents = True
End Sub

谢谢

标签： excelvbafind-occurrences

解决方案

我设法通过输出范围使其更快，如下所示：

Sub ContactCycle()
Dim WsMaster As Worksheet
Dim WsLastRow As Long
Dim OutputRange As Range
Dim tmpCalc As XlCalculation: tmpCalc = Application.Calculation 'Save setting
Const OutputColumn As Long = 28 ' "AB"

Set WsMaster = ThisWorkbook.Worksheets("Master")
Set MyContactCycleRange = WsMaster.Range("AB5:AB" & WsLastRow)
Set OutputRange = WsMaster.Range(WsMaster.Cells(5, OutputColumn), WsMaster.Cells(WsLastRow, OutputColumn))


Application.Calculation = xlCalculationManual 'Makes things slightly faster
     With OutputRange
        .Formula = "=IF(SUMPRODUCT(COUNTIF(INDIRECT(""'""&Weeks&""'!""&""$A$6:$A$45""),$B5))>0,1,0)"  'This will fill down automatically
        .Calculate 'Needed because Calculation is currently manual
        .Value = .Value 'Convert the formulae into flat values
        .HorizontalAlignment = xlCenter
        .Font.Color = RGB(0, 32, 96)
        .Font.Bold = True
        .Font.Size = 9
        .Font.Name = "Calibri"
        .NumberFormat = "0"
    End With
        Application.Calculation = tmpCalc 'Restore setting saved earlier
End Sub

推荐阅读