Оптимизировать цвет интерьера основных элементов - PullRequest
Новая
       4

Оптимизировать цвет интерьера основных элементов

0 голосов
/ 01 мая 2018

Есть ли лучший способ выполнить этот код быстрее? Это занимает вечность в течение 12 месяцев, и я не уверен, почему. Я пытался использовать переменные для определения цветов, но это не очень помогает.

Спасибо. 

Sub Color()

Application.ScreenUpdating = False

With ActiveSheet.PivotTables("Calendar").PivotFields("Month")
.PivotItems("jan").LabelRange.Interior.Color = RGB(255, 255, 0)
.PivotItems("jan").DataRange.Interior.Color = RGB(255, 255, 0)
.PivotItems("feb").LabelRange.Interior.Color = RGB(255, 153, 0)
.PivotItems("feb").DataRange.Interior.Color = RGB(255, 153, 0)
End With

Application.ScreenUpdating = True

End Sub

Ответы [ 2 ]

0 голосов
/ 01 мая 2018

Это сработало для меня. Это заняло всего несколько секунд. 

Sub Color_two()
Dim Color(12)
    Color(1) = RGB(255, 255, 0)
    Color(2) = RGB(255, 153, 0)
    Color(3) = RGB(255, 153, 0)
    Color(4) = RGB(255, 0, 0)
    Color(5) = RGB(255, 0, 255)
    Color(6) = RGB(102, 0, 204)
    Color(7) = RGB(51, 0, 255)
    Color(8) = RGB(0, 0, 255)
    Color(9) = RGB(51, 102, 102)
    Color(10) = RGB(153, 255, 0)
    Color(11) = RGB(153, 153, 153)
    Color(12) = RGB(153, 255, 0)
With ActiveSheet.PivotTables("Calendar")
    For i = 1 To 12
        Mmonth= "'" & i & "'"
        .PivotSelect "Month[" & Mmonth & "]", xlDataAndLabel, True
        Selection.Interior.Color = Color(i)
    Next i
End With
End Sub
0 голосов
/ 01 мая 2018

Возможно, установите Application.Calculation = xlCalculationManual и затем вернитесь к Application.Calculation = xlCalculationAutomatic в конце.

Это предотвратит обновление сводной таблицы каждый раз, когда вы что-то делаете с ней. Я думаю, это странно, если это освежает только потому, что вы играете с цветом, но это превосходно, а превосходство может быть странным. 

Sub Color()

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  With ActiveSheet.PivotTables("Calendar").PivotFields("Month")
    .PivotItems("jan").LabelRange.Interior.Color = RGB(255, 255, 0)
    .PivotItems("jan").DataRange.Interior.Color = RGB(255, 255, 0)
    .PivotItems("feb").LabelRange.Interior.Color = RGB(255, 153, 0)
    .PivotItems("feb").DataRange.Interior.Color = RGB(255, 153, 0)
  End With

  'Force a calc before toggling calculation back on
  Application.Calculate
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

End Sub

Вы также можете отключить Application.EnableEvents, пока он работает, только для того, чтобы покрыть ваши базы. Это предотвратит запуск любого другого кода на листе, вызванного событием. Как Worksheet_SelectionChange или что у тебя.

...