Сводная таблица Excel VBA Изменение цвета ячеек

Question

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

Вот как выглядит мой текущий экран "анализа" без сводных таблиц: Тем не менее, я поместил сводные таблицы в черные ящики, и у меня есть макрос для их автоматического обновления после импорта дополнительных данных.Ниже:

Sub UpdatePivots()
    ' This sub is intended to update all pivot charts in the by switching to the appropriate
    ' worksheet, locating the appropriate pivot table, and updating them.

    Dim ws As Worksheet
    Dim PT As PivotTable
    Dim pvtItem As PivotItem

    For Each ws In ActiveWorkbook.Worksheets '<~~ Loop all worksheets in workbook
        For Each PT In ws.PivotTables        '<~~ Loop all pivot tables in worksheet
            PT.PivotCache.Refresh
        Next PT
    Next ws
End Sub

Однако импортированные данные изменяются.Иногда он очень маленький, иногда очень большой, и поэтому я получаю сводные таблицы, которые выглядят так:

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

Answer 1

Вы можете использовать стандартный идентификатор последней строки, а затем раскрасить ваши внутренние ячейки ниже.Вам нужно будет выбрать максимальный номер строки (здесь всегда цвет от последней строки до 100, поэтому при необходимости измените 100).Вам также необходимо установить столбцы, так как у вас есть черная рамка.

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

Это решение будет работать для левой оси.Вам нужно будет дублировать две строки кода, которые я добавил для сводки справа.

---

Sub UpdatePivots()

Dim ws As Worksheet
Dim PT As PivotTable, pvtItem As PivotItem
Dim LRow As Long

For Each ws In ActiveWorkbook.Worksheets
    For Each PT In ws.PivotTables
        PT.PivotCache.Refresh
        LRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Offset(1).Row
        ws.Range(ws.Cells(LRow, "D"), ws.Cells(100, "G")).Interior.Color = 11184814
    Next PT
Next ws

End Sub

---

Если вы не знаете цветовой код, вы можете запустить приведенный ниже код, чтобы найти его!

Sub ColorCode()

Dim Target As Range
Set Target = Application.InputBox("Select desired cell to return color code", Type:=8)

If Not Target.Count > 1 Then
    MsgBox "Color Code: " & Target.Interior.Color
End If

End Sub