运行宏后Excel很慢，有没有办法改进我的代码?

Question

我写了一个宏，突出显示了"Y"列中的关键字。脚本确实有效并且完全符合我的需要，但它会减慢很多速度，就像它仍在做某事一样。我的猜测是它与 FOR 循环有关，但我不确定如何解决它。

我的 VBA 知识非常有限，这是我在谷歌上搜索解决方案所获得的。我希望有人可以帮助我完成我的代码。

Sub HighlightKeywords()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim sPos As Long, sLen As Long
Dim rng As Range
Dim findMe As String
Dim i As Integer
Dim t As Integer
Dim SearchArray
SearchArray = Array("WORD1", "WORD2")

For t = 0 To SearchArray
Set rng = Range("Y2:Y1000")
findMe = SearchArray(t)
For Each rng In rng
With rng
If LCase(rng.Value) Like "*" & LCase(findMe) & "*" Then
If Not rng Is Nothing Then
For i = 1 To Len(rng.Value)
sPos = InStr(i, UCase(rng.Value), UCase(findMe))
sLen = Len(findMe)
If (sPos <> 0) Then
rng.Characters(Start:=sPos, 
Length:=sLen).Font.Color = RGB(255, 0, 0)
i = sPos + Len(findMe) - 1
End If
Next i
End If
End If
End With
Next rng
Next t
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

试试这个。

我只是删除任何可能不需要的东西，以及任何我认为可能出错的东西。 无论如何，我没有测试，因为我不知道它的真正用途。

Sub HighlightKeywords()
Dim sPos As Long, sLen As Long
Dim rng As Range
Dim Sample As Range
Dim i As Integer
Dim t As Integer
Dim SearchArray
With Application 
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
SearchArray = Array("WORD1", "WORD2")
Set rng = Range("Y2:Y1000")
For t = 0 To Ubound(Array, 1) 'Are you sure to look for item 0?
For Each Sample In rng
With Sample
If LCase(.Value) Like "*" & LCase(SearchArray(t)) & "*" And Not .Value Is Nothing Then
For i = 1 To Len(.Value)
sPos = InStr(i, UCase(.Value), UCase(SearchArray(t)))
sLen = Len(SearchArray(t))
If (sPos <> 0) Then
.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
i = sPos + Len(SearchArray(t)) - 1
End If
Next i
End If
End With
Next
Next t
With Application 
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
End With    
End Sub

希望对您有所帮助。