标记颜色-VBA条件格式法

情人节快乐！

小伙遇到如下问题

如图

要求

将A列地址一样的对应字段 

值1 到值14区域中数据进行判断并填充颜色,

如果区域中值一样的大于1则标红色字体,

如果区域中值存在正负偏差1的,

则标红色字体

效果如图

如何做到的呢？

PS:手工做完的最强大

哈哈哈哈哈

来

看土豆哥代码

Option Explicit

Sub 条件格式法()

Dim C As Range

Dim xRow As Integer, myColor As Integer

Dim Arr(1), myTim As Single

    myTim = Timer '算程序运行时间套路

    Arr(0) = 15

    Arr(1) = 35

    Cells.FormatConditions.Delete '清空条件格式

    Cells.Interior.ColorIndex = 0 '清空填充颜色

    Application.ScreenUpdating = False '防屏闪

    For xRow = 2 To 3550

        myColor = myColor + 1

        Set C = Range('A:A').Find(Cells(xRow, 'A').Value, , xlValues, xlWhole, , xlPrevious)

        设置格式 Range(Cells(xRow, 'b'), C.Offset(, 14)).Address

        xRow = C.Row

        DoEvents

    Next

    Application.ScreenUpdating = True '防屏闪

    MsgBox '运行完毕,用时:' & Format(Timer - myTim, '0.0000') & vbCr _

    & '共计设置: ' & Cells.FormatConditions.Count & ' 个条件格式', , '土豆提示' '算程序运行时间套路

End Sub

Sub 设置格式(ByVal strAddress As String)

Dim rngAddress, celAddress

    rngAddress = Range(strAddress).Address

    

    celAddress = Range(rngAddress).Cells(1).Address(0, 0)

    With Range(rngAddress).FormatConditions

        .Add Type:=xlExpression, Formula1:= _

        '=OR(COUNTIF(' & rngAddress & ',' & celAddress & ')>1,COUNTIF(' & _

        rngAddress & ',' & celAddress & '+1)>0,COUNTIF(' & rngAddress & ',' & celAddress & '-1)>0)'

        .Item(.Count).Font.ColorIndex = 3

    End With

End Sub

***华丽分割线***

SQL课程下周二开课

赶快联系合伙人“L-L-X”报名

有优惠哦！

爱上Excel合伙人课程

SQL基础课程499

函数七天199

函数中级600

技巧课398

SQL高级课程499

VBA基础499

VBA高级699

备注：现在报名有优惠，报名入口（点击爱上Excel合伙人公众号菜单【活动】联系L-L-X）