Тепловая карта с использованием VBA / условное форматирование - PullRequest
Новая
       37

Тепловая карта с использованием VBA / условное форматирование

0 голосов
/ 30 сентября 2018

Я пытаюсь создать тепловую карту "старого" инвентаря.Я создал карту всех мест инвентаризации и использую условное форматирование, чтобы выделить ячейки со старым инвентарём на каждом листе.Есть 7 листов, представляющих каждый уровень определенного места.

Места 1 уровня :
img

Места 2 уровня :
img

У меня будет скрытый лист с количеством эритроцитов для каждого местоположения (Пример: посмотрите на ячейку C4 на всех 7 листах и ​​сохраняйте количество красных ячеек)

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

Я используюследующий код VBA, чтобы попытаться выполнить это: 

Function ColorFunction(rColor As Range, rRange As Range, rRange2 As Range, _
        rRange3 As Range, rRange4 As Range, rRange5 As Range, _
        rRange6 As Range, rRange7 As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult
    lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange2
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange3
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange4
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange5
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange6
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
        For Each rCell In rRange7
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If
    ColorFunction = vResult
End Function

Справочный лист 3 ниже:

Я вижу пару проблем, когда я применяю то же условное условиеформатирование в ячейку на том же листе (A1) и указание, что для цвета мой счет отображается как 7, как будто цвет не применяется, так как на каждом из 7 листов есть «Без заполнения».Если я изменю цвет любой из C4 ячеек на что-либо другое (Белый, Желтый, Фиолетовый), число уменьшится до 6,5,4 ....

Я вручную добавил красный цвет вячейка A3, и если я вручную раскрасю одну из C4 ячеек в красный цвет, я получу точное количество.

Лист 3 (счетчик цветов): img

Есть какие-либо предложения относительно того, как я могу это исправить?Я уже проверил, что условное форматирование, примененное ко всем 7 листам, использует RGB (255,0,0), а ручная красная ячейка также RGB (255,0,0).Я в полной растерянности.

1 Ответ

0 голосов
/ 30 сентября 2018

Если вы хотите проверить цвет из условного форматирования, вам нужно использовать DisplayFormat.Interior.ColorIndex.Ваш текущий код будет обнаруживать только статические цветовые заливки.

Не проверено: 

Function ColorFunction(rColor As Range, rRange As Range, rRange2 As Range, _
        rRange3 As Range, rRange4 As Range, rRange5 As Range, _
        rRange6 As Range, rRange7 As Range, Optional SUM As Boolean)

    Dim rCell As Range, rng
    Dim lCol As Long
    Dim vResult
    lCol = rColor.Interior.ColorIndex

    If SUM = True Then
        For Each rCell In rRange
            If rCell.DisplayFormat.Interior.ColorIndex = lCol Then
                vResult = vResult + rCell.Value
            End If
        Next rCell
    Else
        For Each rng In Array(rRange, rRange2, rRange3, rRange4, _
                              rRange5, rRange6, rRange7)
            For Each rCell In rng.Cells
                If rCell.DisplayFormat.Interior.ColorIndex = lCol Then
                    vResult = 1 + vResult
                End If
            Next rCell
        Next rng
    End If
    ColorFunction = vResult
End Function
...