更改单元格颜色以匹配相邻单元格的条件格式

Question

我正在开发前端以轻松查看日历上的数据。数据是从另一个工作簿上的第二个表中提取的。我已经从源表中提取数据，并且可以有条件地格式化实际值，但日历日期不能应用相同的条件格式。只有日历中每个日期的一半被格式化是非常不吸引人的，我希望每对的顶部单元格与底部单元格匹配。

由于条件格式是一个掩码，尝试通过 VBA 复制单元格颜色未成功。由于 Excel 处理条件格式的方式，使用代码 Range("I2").Interior.Color = Range("I3").Interior.Color 会更改 I2 的颜色以匹配没有背景颜色的 I3 的颜色。

有两种替代解决方案，但我希望避免使用它们：

1. 我可以将一系列单一条件格式应用于包含以下内容的单元格 日期值并手动创建渐变效果。这确实输了 3 颜色渐变的一些效果，但是它是 一目了然区分细胞的速度稍慢。

2. 我可以使用 VBA 手动计算应该应用的颜色 到每个单元格。虽然这与我的效果相同 寻找，我希望计算和编码需要更长的时间 比一个简单的项目所需要的。

---

有没有办法将下面的条件格式应用于仅与值相邻的单元格？

编辑/所需的格式看起来像这样，除了它会被计算而不是手动应用：

Answer 1

虽然我不知道最初提出的问题是否可行，但我已经完成了替代解决方案 #2：

使用 VBA 手动计算应应用于每个单元格的颜色。

在日历页面上，我添加了一个按钮（表单控件），并创建了一个宏以在单击时运行。该宏使用输入值更新计算表（控制显示的每日值），然后计算日历正方形上半部分所需的渐变颜色。当前的电子表格如下所示：

我保留了条件格式来为正方形的下半部分着色，但也可以从 VBA 端进行处理。

按钮宏代码如下；

Sub loadDetails_Click()

Dim area1colMin As Integer
Dim area1colMax As Integer
Dim area2colMin As Integer
Dim area2colMax As Integer
Dim rowMin As Integer
Dim rowMax As Integer

area1colMin = 6
area1colMax = 12
area2colMin = 14
area2colMax = 20
rowMin = 3
rowMax = 29

' Insert input value into calculation spreadsheet, making sure
' values/conditional formatting calculation waits until the code is ran.

ThisWorkbook.Sheets("VBACalcPage").Range("A6").Value = ThisWorkbook.Sheets("SingleItemLookup").Range("C1").Value

colorArea area1colMin, area1colMax, rowMin, rowMax
colorArea area2colMin, area2colMax, rowMin, rowMax

End Sub

宏调用函数colorArea()两次；

Public Function colorArea(minC As Integer, maxC As Integer, minR As Integer, maxR As Integer)

Dim tempCellValue As Integer
Dim cnstPosR As Integer
Dim cnstPosG As Integer
Dim cnstPosB As Integer
Dim cnstNegR As Integer
Dim cnstNegG As Integer
Dim cnstNegB As Integer
Dim colorTempRed As Integer
Dim colorTempGreen As Integer
Dim colorTempBlue As Integer
Dim intPosCap As Integer
Dim intNegCap As Integer
Dim colorPushRed As Integer
Dim colorPushGreen As Integer
Dim colorPushBlue As Integer


cnstPosR = 79
cnstPosG = 129
cnstPosB = 189
cnstNegR = 192
cnstNegG = 80
cnstNegB = 77
intPosCap = 1000
intNegCap = -1000

For column = minC To maxC
    For row = minR To maxR
        If row Mod 2 = 1 Then
            tempCellValue = Cells(row, column).Value
            If tempCellValue > 0 Then
                colorTempRed = cnstPosR
                colorTempGreen = cnstPosG
                colorTempBlue = cnstPosB
            Else
                colorTempRed = cnstNegR
                colorTempGreen = cnstNegG
                colorTempBlue = cnstNegB
            End If
            If tempCellValue > 1000 Then tempCellValue = 1000
            If tempCellValue < -1000 Then tempCellValue = -1000

            colorPushRed = 255 - ((255 - colorTempRed) * Abs(tempCellValue / 1000))
            colorPushGreen = 255 - ((255 - colorTempGreen) * Abs(tempCellValue / 1000))
            colorPushBlue = 255 - ((255 - colorTempBlue) * Abs(tempCellValue / 1000))

            Cells(row - 1, column).Interior.Color = RGB(colorPushRed, colorPushGreen, colorPushBlue)
        End If
    Next row
Next column

End Function