使用 VBA/条件格式的热图答案

【问题标题】：Heat Map Using VBA/Conditional Formatting使用 VBA/条件格式的热图
【发布时间】：2019-03-05 13:00:29
【问题描述】：

我正在尝试创建“旧”库存的热图。我创建了所有库存位置的地图，并使用条件格式突出显示每张纸上包含旧库存的单元格。有 7 张表代表某个位置的每个级别。

1 级位置：

2 级位置：

我将有一个隐藏的工作表，其中包含每个位置的红色单元格计数（例如：查看所有 7 个工作表上的单元格 C4 并保留红细胞计数）

我将参考这些计数来格式化位置概览表（绿色、黄色、橙色、红色）。

我正在使用以下 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（颜色计数）：

关于如何解决这个问题有什么建议吗？我已经验证了应用于所有 7 张纸的条件格式是使用 RGB(255,0,0) 并且手动红色单元格也是 RGB(255,0,0)。我完全不知所措。

【问题讨论】：

抱歉，我自己抓到了。我更新了图像以显示行和列标题。至于代码，是的，我对 VBA 几乎没有经验，但是当我手动填充每个单元格时，它似乎在某种程度上可以工作
我将您的图片裁剪为仅包含一个示例。（见minimal reproducible example）。单击图像仍将打开您的“全屏”版本。 . . .你能澄清一下，你只需要7张工作表上的红细胞总数吗？如果是这样，这个网站和其他网站上有几个例子（如this one）。此外，您可以使用 the Union Function 组合 7 个重复的 If/For 语句来删除一半以上的代码。
如果你想从条件格式中检查颜色，那么你需要使用DisplayFormat.Interior.ColorIndex。您当前的代码只会检测手动应用的颜色填充。

标签： vba excel conditional-formatting

【解决方案1】：

如果您想通过条件格式检查颜色，则需要使用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

【讨论】：