求助VBA实现符合条件的字符自动标红

蓝土豆仔

笨鸟飞不高 发表于 2023-7-10 14:56
做了一个，规则又变了一个，规则真灵活，。。。

规则没变动，都是两列一个规则，我刚才是把D5到K5的标题文字修改了，附件上那么写是方便老师了解诉求

笨鸟飞不高

ykcbf1100 发表于 2023-7-10 15:01
工作表循环一下。
看你这个实际中还真有需求？

本来也想问楼主。。。。。。

笨鸟飞不高

蓝土豆仔 发表于 2023-7-10 15:05
规则没变动，都是两列一个规则，我刚才是把D5到K5的标题文字修改了，附件上那么写是方便老师了解诉求

不想弄了，等其他老师的解答吧。。。

ykcbf1100

笨鸟飞不高 发表于 2023-7-10 15:09
本来也想问楼主。。。。。。

这个需求有点奇怪，我当时以为规则只改变一次，没想到是每二列变一次。
其实，弄懂规则，也不难吧。

gwjkkkkk

这个规则就是没规则。。。

风飘绝影

ykcbf1100 发表于 2023-7-10 13:06
范围改一下就行了，我看你下面是说明文字，所以，就固定范围了。

老师，您的这段代码怎样修改才能识别公式转换过来的值？
Sub ykcbf()  '//2023.7.10
    Dim zrr
    With Sheet1
        .[d6:k36].Font.ColorIndex = 0
        For j = 4 To 11
            For i = 6 To 36
                st = CStr(.Cells(i, 3)): s = CStr(.Cells(i, j))
                If j < 6 Then
                    ReDim zrr(1 To 2)
                    zrr(1) = Left(st, 1): zrr(2) = Mid(st, 4, 1)
                    For x = 1 To Len(s)
                        If Mid(s, x, 1) = zrr(1) Or Mid(s, x, 1) = zrr(2) Then
                            .Cells(i, j).Characters(Start:=x, Length:=1).Font.ColorIndex = 3
                        End If
                    Next
                End If
                If j > 5 And j < 8 Then
                    ReDim zrr(1 To 2)
                    zrr(1) = Mid(st, 2, 1): zrr(2) = Mid(st, 3, 1)
                    For x = 1 To Len(s)
                        If Mid(s, x, 1) = zrr(1) Or Mid(s, x, 1) = zrr(2) Then
                            .Cells(i, j).Characters(Start:=x, Length:=1).Font.ColorIndex = 3
                        End If
                    Next
                End If
                If j > 7 And j < 10 Then
                    ReDim zrr(1 To 3)
                    zrr(1) = Left(st, 1): zrr(2) = Mid(st, 2, 1): zrr(3) = Mid(st, 3, 1)
                    For x = 1 To Len(s)
                        If Mid(s, x, 1) = zrr(1) Or Mid(s, x, 1) = zrr(2) Or Mid(s, x, 1) = zrr(3) Then
                            .Cells(i, j).Characters(Start:=x, Length:=1).Font.ColorIndex = 3
                        End If
                    Next
                End If
                If j > 9 And j < 12 Then
                    ReDim zrr(1 To 3)
                    zrr(1) = Mid(st, 2, 1): zrr(2) = Mid(st, 3, 1): zrr(3) = Mid(st, 4, 1)
                    For x = 1 To Len(s)
                        If Mid(s, x, 1) = zrr(1) Or Mid(s, x, 1) = zrr(2) Or Mid(s, x, 1) = zrr(3) Then
                            .Cells(i, j).Characters(Start:=x, Length:=1).Font.ColorIndex = 3
                        End If
                    Next
                End If
            Next
        Next
    End With
End Sub

ykcbf1100

风飘绝影 发表于 2023-7-12 17:20
老师，您的这段代码怎样修改才能识别公式转换过来的值？
Sub ykcbf()  '//2023.7.10
    Dim zrr

你用公式的话，结果如果是文本的话也适用吧。如果不是文本的话就不能搞了。