判断内容是否符合要求并涂色

天地一相

感谢帮助！详见截图附件。

gwjkkkkk

请参考。。。

liulang0808

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    r = Cells(Rows.Count, 2).End(3).Row
    arr = [A1].Resize(r, 21)
    For j = 2 To UBound(arr, 2)
        brr = Split(arr(3, j), "-")
        d(j) = brr
    Next j
    Set Rng = Nothing
    For j = 4 To UBound(arr)
        For i = 2 To UBound(arr, 2)
            If Val(arr(j, i)) > Val(d(i)(1)) Or Val(arr(j, i)) < Val(d(i)(0)) Then
                GoTo l1
            End If
        Next i
        If Rng Is Nothing Then
            Set Rng = Cells(j, 2).Resize(1, 20)
        Else
            Set Rng = Union(Rng, Cells(j, 2).Resize(1, 20))
        End If
l1:
    Next j
    If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 8
End Sub

liulang0808

没有满足添加底色的区域

shiruiqiang

今日练题，是否这样？

leirongqin

练习一下。。。

liulang0808

这个是按照单元格比较
之前的是整行比较