VBA基于单元格文本填充颜色

我试图根据关键字在2500行表格中填充单元格。有10个关键字和3种不同的颜色，我需要。我想出了以下，但我得到“运行时错误'13'：类型不匹配”。恐怕我不知道那是什么。VBA基于单元格文本填充颜色

Sub ColourChange() 
    Dim cell As Range 
    For Each cell In Range("a2:az500") 
     If cell.Value = "Available" Then 
      cell.Interior.Color = XlRgbColor.rgbLightGreen 
     ElseIf cell.Value = "Deal" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Sold +Excl" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Sold Excl" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Holdback" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Pending" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Expired" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Sold CoX" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.Value = "Resell" Then 
      cell.Interior.Color = XlRgbColor.rgbLightGreen 
     ElseIf cell.Value = "Sold nonX" Then 
      cell.Interior.Color = XlRgbColor.rgbBlue 
     ElseIf cell.Value = "Sold NonX" Then 
      cell.Interior.Color = XlRgbColor.rgbBlue 
     End If 
    Next 
End Sub

谢谢！结束如果之前

Else 
debug.print cell.value & cell.address

：

来源

2017-10-19 J Dodge

，如果你有在小区中的错误可能发生。检查内容是否中断。 – SJR

雅，它没有明显的原因退出237行？ –

为什么不使用条件格式，因为你的范围是硬编码的？此外，如果不满足这些条件，您应该使用Case Select和其他选项。 – mooseman

加入该行。它会告诉你哪个单元格在编辑器的立即窗口上提示错误

来源

2017-10-19 20:30:20 Alex

我可以建议条件格式吗？我相信它会更简单，并且可以避免任何运行时错误。

如果您选择范围 - >按主页选项卡 - >条件格式 - >高亮细胞规则 - >包含

然后，您可以设置为细胞是否含有规则文本“可“，突出显示它的细胞淡绿色。你可以添加尽可能多的规则，只要你愿意。你甚至可以为整张纸做，所以它从来都不是有限的范围。

来源

2017-10-19 20:34:57

正如@SJR建议的那样，单元格中可能存在错误。

Sub ColourChange() 
    Dim cell As Range 
    For Each cell In Range("a2:az500") 
     If IsError(cell.value) Then 
      cell.Interior.Color = XlRgbColor.rgbOrange 
     ElseIf cell.value = "Available" Then 
      cell.Interior.Color = XlRgbColor.rgbLightGreen 
     ElseIf cell.value = "Deal" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Sold +Excl" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Sold Excl" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Holdback" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Pending" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Expired" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Sold CoX" Then 
      cell.Interior.Color = XlRgbColor.rgbRed 
     ElseIf cell.value = "Resell" Then 
      cell.Interior.Color = XlRgbColor.rgbLightGreen 
     ElseIf cell.value = "Sold nonX" Then 
      cell.Interior.Color = XlRgbColor.rgbBlue 
     ElseIf cell.value = "Sold NonX" Then 
      cell.Interior.Color = XlRgbColor.rgbBlue 
     End If 
    Next 
End Sub

来源

2017-10-19 20:39:25

这将解决你出错的问题

Sub ColourChange() 
Dim cell As Range 
For Each cell In Range("a2:az500") 
If Not iserror(cell.Value) Then 
    If cell.Value = "Available" Then 
    cell.Interior.Color = XlRgbColor.rgbLightGreen 
    ElseIf cell.Value = "Deal" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Sold +Excl" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Sold Excl" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Holdback" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Pending" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Expired" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Sold CoX" Then 
    cell.Interior.Color = XlRgbColor.rgbRed 
    ElseIf cell.Value = "Resell" Then 
    cell.Interior.Color = XlRgbColor.rgbLightGreen 
    ElseIf cell.Value = "Sold nonX" Then 
    cell.Interior.Color = XlRgbColor.rgbBlue 
    ElseIf cell.Value = "Sold NonX" Then 
    cell.Interior.Color = XlRgbColor.rgbBlue 
    End If 
End If 'error check 
Next 
End Sub

来源

2017-10-19 20:47:37 mooseman

除了其他人所说的主要解决方案，另外还有一个问题

我试图填补细胞在2500排片

你的代码工作的前500行只
要么重新定义的主要范围从Range("a2:az500")到Range("a2:az2500")
或者用更动态的UsedRange区域

版本1是您的代码为精简格式：

Option Explicit 

Public Sub ColourChange1() 
    Dim itm As Range 

    Application.ScreenUpdating = False 
    Sheet1.UsedRange.Offset(1).Interior.ColorIndex = xlColorIndexNone 

    For Each itm In Sheet1.UsedRange.Offset(1) 
     If Not IsError(itm) Then 
      With itm 
       Select Case .Value2 
        Case "Available", "Resell" 
         .Interior.Color = XlRgbColor.rgbLightGreen 
        Case "Deal", "Sold +Excl", "Sold Excl", "Holdback", _ 
         "Pending", "Expired", "Sold CoX" 
         .Interior.Color = XlRgbColor.rgbRed 
        Case "Sold nonX", "Sold NonX" 
         .Interior.Color = XlRgbColor.rgbBlue 
       End Select 
      End With 
     End If 
    Next 
    Application.ScreenUpdating = True 
End Sub

2版是更大的数据集快得多，如果所有关键字均在一列（A）：

Public Sub ColourChange2() 
    Dim mapping As Object, itm As Variant 

    Set mapping = CreateObject("Scripting.Dictionary") 

    mapping(XlRgbColor.rgbLightGreen) = Array("Available", "Resell") 

    mapping(XlRgbColor.rgbRed) = Array("Deal", "Sold +Excl", "Sold Excl", _ 
             "Holdback", "Pending", "Expired", "Sold CoX") 

    mapping(XlRgbColor.rgbBlue) = Array("Sold nonX", "Sold NonX") 

    Application.ScreenUpdating = False 
    Sheet1.AutoFilterMode = False 
    With Sheet1.UsedRange 
     .Interior.ColorIndex = xlColorIndexNone 
     For Each itm In mapping 
      .AutoFilter Field:=1, Criteria1:=mapping(itm), Operator:=xlFilterValues 
      .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Interior.Color = itm 
     Next 
     .AutoFilter 
    End With 
    Application.ScreenUpdating = True 
End Sub

来源

2017-10-19 23:03:40

VBA基于单元格文本填充颜色

回答

相关问题