Question

我正在尝试根据关键字填充2500行表格中的单元格。我需要10个关键字和3种不同的颜色。我想出了以下内容，但我得到“运行时错误'13'：类型不匹配”。我担心我不知道那是什么。

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

谢谢！

Ĵ

Answer 1

添加一行：

Else
debug.print cell.value & cell.address

在结束之前

。它将告诉您哪个单元格在编辑器的即时窗口中提示错误

Answer 2

我可以建议条件格式吗？我相信它会不那么复杂，并且会避免任何运行时错误。

如果您选择范围 - ＆gt;按主页选项卡 - ＆gt;条件格式 - ＆gt;突出细胞规则 - ＆gt;包含

的文字

然后，您可以为单元格是否包含“可用”设置规则，将单元格突出显示为绿色。您可以根据需要添加任意数量的规则。你甚至可以为整张纸做这件事，所以它永远不是一个有限的范围。

Answer 3

正如@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

Answer 4

这将解决您的错误问题

TimeCalculation Count
---------------------
Pre-9AM           10
Between 9AM-6AM  583
Post-6PM           0

Answer 5

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

我试图填写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

如果所有关键字都在一列（A）中，

版本2 对于大型数据集要快得多：

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

VBA根据单元格文本填充颜色

5 个答案: