根据具有特定标题的列对值进行颜色编码

我有这个代码在VB中定义列标题的数组,我想复制/粘贴在另一个选项卡在Excel中。 然而,在其中一个新选项卡中,我也想根据它们在与该数组中的位置2相对应的“BOM PROCESS TYPE(A,U,R,D)”列中的值进行颜色编码。 代码运行时没有给我一个错误,但单元格根本不会改变颜色。 跳过一些部分,这是我的,有谁知道如何解决它?

“我的变数。

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 

有什么想法吗?

我刚刚模拟你的着色代码,并得到它的工作。 我相信你的问题是v = 2行这是因为你已经分配你的数组和默认的excel设置的方式。 使用上面的方法分配数组的下边界是0,所以这意味着你v = 2指的是“备选项目:组”列,所以它没有在该列中findD,R或U. 你可以改变V = 1(这个工作原理),或者在模块的顶部设置选项库1,因为这会将默认的下限改为1.实际上,如果你有多个模块,你忘记把选项库1放在它们的顶部,你可能会得到意想不到的结果。 如上所述,你不需要yoru里面的Sheets(“BOM”)With block,但是不影响它的工作。 这是稍微修改的代码,适合我

 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 

当你使用build筑,你不应该使用表(“BOM”),如果你?

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

如果您的目标图纸和单元格着色的逻辑是一致的,那么您是否可以在目标工作表单元格上使用条件格式来实现所需的目标。 那么你所有的macros需要做的就是复制。

Interesting Posts