通过具有特定标题的列根据值对单元格进行颜色编码

Posted 2023-02-16

【中文标题】通过具有特定标题的列根据值对单元格进行颜色编码

【英文标题】：Color coding cells based on value through a column with specific header

【发布时间】：2015-02-09 22:45:58

【问题描述】：

我在 vba 中有这段代码，它定义了列标题的数组，我想在 Excel 的另一个选项卡中复制/粘贴。但是，在其中一个新选项卡中，我还想根据它们在“BOM 过程类型（A，U，R，D）”列中的值对一些单元格进行颜色编码，该列对应于该数组中的位置 2。代码运行没有给我一个错误，但单元格根本不改变颜色。跳过一些部分，这是我的，有人知道如何解决吗？

'我的变量。

Dim i As Long, rngCell As Range, rCell As Range
Dim c As Long, v As Long, vMHDRs As Variant, vBHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet

vBHDRs = Array("BOM LEVEL", "BOM PROCESS TYPE (A, U, R, D)", "ALTERNATIVE ITEM: GROUP")

'跳过大部分代码，跳转到颜色编码部分：

With Sheets("BOM")
v = 2
Set rngCell = Sheets("BOM").UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)   
If Not rngCell Is Nothing Then        
Set rngCell = Intersect(Sheets("BOM").UsedRange, rngCell.EntireColumn)
    For Each rCell In rngCell
    If rCell.Value = "D" Then rCell.Interior.ColorIndex = 3
    If rCell.Value = "R" Then rCell.Interior.ColorIndex = 6
    If rCell.Value = "U" Then rCell.Interior.ColorIndex = 6
    Next
End If
End With

有什么想法吗？

【参考方案1】：

当您使用 With 构造时，您不应该使用 Sheets("BOM")，对吗？

Set rngCell = .UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)  

【讨论】：

在每个循环中尝试 MsgBox(rCell.Address)。如果它是空的，那么你知道你必须在哪里搜索:)

【参考方案2】：

如果您的目标工作表和围绕单元格着色的逻辑是一致的，那么您能否在目标工作表单元格上使用条件格式来实现您想要的目标。然后你的宏需要做的就是复制。

【讨论】：

是的，但我的宏也会创建新工作表，因此我无法使用条件格式事先在工作表上设置格式。

【参考方案3】：

我刚刚模拟了您的着色代码并使其正常工作。我相信你的问题是 v=2 线 这是因为您分配数组的方式和默认的 excel 设置。使用上述方法分配数组时的下限为 0，因此这意味着您 v=2 指的是“ALTERNATIVE ITEM: GROUP”列，因此在该列中找不到 D、R 或 U。 您可以更改为 V=1（这可行）或在模块顶部设置选项 base 1，因为这会将默认下限更改为 1。如果您有多个模块，我实际上建议不要使用选项 base 1您忘记将选项 base 1 放在所有选项的顶部，您可能会得到意想不到的结果。 如上所述，您不需要 yoru With 块内的 Sheets("BOM") ，但这并不影响它的工作。这是对我有用的稍微修改过的代码

Sub test2()
Dim i As Long, rngCell As Range, rCell As Range
Dim c As Long, v As Long, vMHDRs As Variant, vBHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet
vBHDRs = Array("BOM LEVEL", "BOM PROCESS TYPE (A, U, R, D)", "ALTERNATIVE ITEM: GROUP")
With Sheets("BOM")
    v = 1
    Set rngCell = Sheets("BOM").UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)
    If Not rngCell Is Nothing Then
    Set rngCell = Intersect(Sheets("BOM").UsedRange, rngCell.EntireColumn)
        For Each rCell In rngCell
        If rCell.Value = "D" Then rCell.Interior.ColorIndex = 3
        If rCell.Value = "R" Then rCell.Interior.ColorIndex = 6
        If rCell.Value = "U" Then rCell.Interior.ColorIndex = 6
        Next
    End If
End With
End Sub