Question

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

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

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

我可以将一系列单一条件格式应用于包含的单元格日期值并手动创建渐变效果。这确实输了然而，它的一些效果是3色渐变稍微慢一点，以区分细胞。
我可以使用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

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

1 个答案: