时间戳

首页 > 解决方案 > Excel 运行宏后很慢，有没有办法改进我的代码？

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

问题描述

我写了一个宏，突出显示“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

标签： excelvba

解决方案

试试这个。

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

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

希望能帮助到你。

推荐阅读