Question

我正在通过使用Worksheet_PivotTableUpdate工作表事件来运行子例程。我的子例程遇到严重的延迟和执行缓慢。如果“单元格”值符合我的代码条件，则“我的子例程”会在数据透视表上设置一列格式。如何避免执行速度慢？

子例程

Option Explicit

Sub setFormatting()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim c As Range, x As Integer

    For x = 13 To 768
        For Each c In Sheet3.Cells(x, 2)
            If c = "ü" Then
                c.Font.Name = "Wingdings"
                c.Font.Bold = True
                c.Font.Size = 14
                c.Font.Color = RGB(0, 176, 80)
            ElseIf c = "X" Then
                c.Font.Bold = True
                c.Font.Size = 12
                c.Font.Color = RGB(247, 79, 79)
            ElseIf c = "RM Apprvd" Then
                c.Font.Color = RGB(212, 140, 10)
                c.Font.Bold = True
            End If
        Next
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

代码调用子例程

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)   
    setFormatting    
End Sub

Answer 1

我允许条件格式应用以下属性：字体颜色和字体样式。我的子例程仅更新字体名称，现在它可以正常运行了。

这是我更新的代码：

Sub setFormatting()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim c As Range

For Each c In Sheet3.Range(Sheet3.Cells(13, 2), Sheet3.Cells(768, 2)).Cells

    If c = "ü" Then

        c.Font.Name = "Wingdings"

    End If

Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Answer 2

尝试使用AutoFilter和SpecialCells方法。

Sub setFormatting()
    Application.ScreenUpdating = False

    With Range(Sheet3.Cells(12,2), Sheet3.Cells(768,2))
        .AutoFilter Field:=1, Criteria1:="ü"
        with .SpecialCells(xlCellTypeVisible).Font
            .Name = "Wingdings"
            .Bold = True
            .Size = 14
            .Color = RGB(0, 176, 80)
        End With
        .Parent.AutoFilterMode = False

        .AutoFilter 1, "X"
        with .SpecialCells(xlCellTypeVisible).Font
            .Bold = True
            .Size = 12
            .Color = RGB(247, 79, 79)
        End With
        .Parent.AutoFilterMode = False

        .AutoFilter 1, "RM Apprvd"
        with .SpecialCells(xlCellTypeVisible).Font
            .Bold = True
            .Color = RGB(212, 140, 10)
        End With
        .Parent.AutoFilterMode = False
    End With

    Application.ScreenUpdating = True
End Sub

如何提高VBA代码的效率？

2 个答案: