根据条件标红，求助大神，先谢谢了。

珍惜的人7758258

蓝桥玄霜 发表于 2023-1-18 10:21
请见附件。

第一种设置大小，等于，设置差值0，行的范围20-25，列的范围C-RR，间隔列4(I与E,M与I,Q与M。。。。)。①当位置开始单元格I20，单元格的数值位置1,2是代表12和19，在E20-E25中有12和19的数值标红。②当位置开始单元格I24，单元格的数值位置3是代表28，在E20-E25中有28的数值标红。位置开始单元格I20可以单独存在，也可与位置开始单元格I24同时存在，多个存在。I与E，M与I,Q与M。。。。。第二个问题从单元格I20和单元格I24，一直算过来到单元格U20和单元格U24,请看图。

珍惜的人7758258

求助大神，新年快乐。

珍惜的人7758258

求助大神，新年快乐。

珍惜的人7758258

手动补图，等于的

smiletwo

其实，计算和逻辑问题最好自己解决，VBA技术问题，用简单的例子模拟下。研究问题的逻辑关系很费脑细胞。

珍惜的人7758258

smiletwo 发表于 2023-2-2 17:02
其实，计算和逻辑问题最好自己解决，VBA技术问题，用简单的例子模拟下。研究问题的逻辑关系很费脑细胞。

自己搞不定，特来诚心求助

demonimissyou

Sub xx()
Dim i, j, j1, j2, j3, j4, k, k1, l%, l1%, l2%, reg, reg1
[A23].CurrentRegion.Font.Color = 7
Set reg = CreateObject("VBscript.regexp")
Set reg1 = CreateObject("VBscript.regexp")
reg.Pattern = "[0-9]+"
reg1.Pattern = "[A-Z]+"
reg.Global = True
reg1.Global = True
For i = [A65536].End(xlUp).Row To 35 Step -1
    Set j = reg1.Execute(Cells(i, 1)) '列数
    Set j1 = reg.Execute(Cells(i, 2)) '单元格的数值位置
    Set j2 = reg.Execute(Range(Cells(i, 1))) '位置开始
    Set j3 = reg.Execute(Cells(28, 1)) '待循环的行数
    j4 = Range("a1:" & Cells(i, 1)).Columns.Count - Cells(32, 1) '待查找的列数
        For k = 1 To j1.Count
            For k1 = j3(0) To j3(1) '循环行数
             l = j2(j1(k - 1) - 1) '等于
             l2 = j2(j1(k - 1) - 1) + 1 + Cells(26, 1) - 1 '大于
             l1 = j2(j1(k - 1) - 1) - Cells(26, 1) '小于
            
               
                If Cells(24, 1) = "等于" And Cells(26, 1) = "0" Then
                If InStr(1, Cells(k1, j4), l, vbTextCompare) > 0 Then
                Cells(k1, j4).Characters(InStr(1, Cells(k1, j4), l, vbTextCompare) - 1, Len(l) + 1).Font.Color = vbRed
                End If
               
                ElseIf Cells(24, 1) = "小于" Then
                If InStr(1, Cells(k1, j4), l1, vbTextCompare) > 0 Then
                Cells(k1, j4).Characters(InStr(1, Cells(k1, j4), l1, vbTextCompare) - 1, Len(l1) + 1).Font.Color = vbRed
                End If
               
                ElseIf Cells(24, 1) = "大于" Then
                If InStr(1, Cells(k1, j4), l2, vbTextCompare) > 0 Then
                Cells(k1, j4).Characters(InStr(1, Cells(k1, j4), l2, vbTextCompare) - 1, Len(l2) + 1).Font.Color = vbRed
                End If

              End If
            Next
        Next
Next
End Sub

speedboy

这个有用。