[已解决]查找到信息后根据条件变色

ms967967

根据内容表中的信息查找图表里的位置
信息都是以"数字+W"为一组，单元格内会有1到4组
内容相同时，变绿色
内容里有信息，图表中没信息变黄色
图表里的信息比内容里多变蓝色
图表里的信息比内容里少变红色
附件请见二楼

最佳答案

月排行榜 / 总排行榜

爱疯

2014-10-12 10:16

Sub Click()
    Dim A, B, d, rng, i%, j%, x$

    Set d = CreateObject("scripting.dictionary")
    A = Sheets("内容").Range("a1").CurrentRegion
    With Sheets("图表")
        B = .Range("a2").CurrentRegion
        .Range("1:" & UBound(B, 2)).Interior.ColorIndex = 0
        .Activate
    End With


    For i = 2 To UBound(A)
        d(A(i, 1) & "|" & A(i, 2)) = A(i, 3)
    Next i
   
    For i = 2 To UBound(B)
        For j = 2 To UBound(B, 2)
            Set rng = Cells(i + 1, j)
            '如果图表要找的，内容表里有
            If d.exists(B(1, j) & "|" & B(i, 1)) Then
                x = d(B(1, j) & "|" & B(i, 1))
                '如果图表的值为可空，就是黄色
                If B(i, j) = "" Then
                    rng.Interior.ColorIndex = 6
                Else
                    '如果值相同，就是绿色
                    If B(i, j) = x Then rng.Interior.ColorIndex = 10
                    '如果图表的值大于内容表的值，就是兰色
                    If Len(B(i, j)) > Len(x) Then rng.Interior.ColorIndex = 8
                    '如果图表的值小于内容表的值，就是红色
                    If Len(B(i, j)) < Len(x) Then rng.Interior.ColorIndex = 3
                End If
            End If
        Next j
    Next i
End Sub


找到后变色.rar (17.75 KB, 下载次数: 27)

2014-10-12 10:16 上传

点击文件名下载附件

跳转到最佳答案楼层

ms967967

找到后变色.rar (8.08 KB, 下载次数: 14)

2014-10-11 06:43 上传

点击文件名下载附件

baksy

ms967967 发表于 2014-10-11 06:43

单元格里都是文本，怎么比多和少？

ms967967

baksy 发表于 2014-10-11 08:02
单元格里都是文本，怎么比多和少？

没办法，我实际应用时就是这个样子。
您能先按相同和不同做吗，相同变绿色，不同变黄色，图表里没有的变蓝色。

ms967967

baksy 发表于 2014-10-11 08:02
单元格里都是文本，怎么比多和少？

没办法，我实际应用时就是这个样子。
您能先按相同和不同做吗，相同变绿色，不同变黄色，图表里没有的变蓝色。

ms967967

有人感兴趣吗

ms967967

真的无法实现吗？

爱疯

Sub Click()
    Dim A, B, d, rng, i%, j%, x$

    Set d = CreateObject("scripting.dictionary")
    A = Sheets("内容").Range("a1").CurrentRegion
    With Sheets("图表")
        B = .Range("a2").CurrentRegion
        .Range("1:" & UBound(B, 2)).Interior.ColorIndex = 0
        .Activate
    End With


    For i = 2 To UBound(A)
        d(A(i, 1) & "|" & A(i, 2)) = A(i, 3)
    Next i
   
    For i = 2 To UBound(B)
        For j = 2 To UBound(B, 2)
            Set rng = Cells(i + 1, j)
            '如果图表要找的，内容表里有
            If d.exists(B(1, j) & "|" & B(i, 1)) Then
                x = d(B(1, j) & "|" & B(i, 1))
                '如果图表的值为可空，就是黄色
                If B(i, j) = "" Then
                    rng.Interior.ColorIndex = 6
                Else
                    '如果值相同，就是绿色
                    If B(i, j) = x Then rng.Interior.ColorIndex = 10
                    '如果图表的值大于内容表的值，就是兰色
                    If Len(B(i, j)) > Len(x) Then rng.Interior.ColorIndex = 8
                    '如果图表的值小于内容表的值，就是红色
                    If Len(B(i, j)) < Len(x) Then rng.Interior.ColorIndex = 3
                End If
            End If
        Next j
    Next i
End Sub


找到后变色.rar (17.75 KB, 下载次数: 27)

2014-10-12 10:16 上传

点击文件名下载附件