Question

我写了一个宏，突出显示“ Y”列中的关键字。脚本确实可以工作，并且可以完全满足我的需求，但是它会大大降低excel的速度，就像它仍在做某些事情一样。我的猜测是它与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

希望有帮助。

运行宏后，Excel速度很慢，有没有办法改善我的代码？

1 个答案: