Как я могу сделать мой код VBA более эффективным?

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

Попробуйте использовать 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

Answer 2

Я разрешаю условное форматирование применять следующие свойства: цвет шрифта и стиль шрифта. Моя подпрограмма только обновляет имя шрифта, теперь она запускается без проблем.

Вот мой обновленный код:

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