条件格式中设定的公式功能如何转换为VBA代码来实现？

mystic_hjj

各位老师，附件中设置的条件格式容易被破坏，比如从外部直接复制带格式的内容后条件格式就失效了，如何通过VBA代码来实现条件格式中公式的功能，还能给出提示。条件格式公式为：=IF(ISNA(VLOOKUP(IF(MOD(LEN(MID(-(1%&$A2),6,14)),2),MID(-(1%&$A2),6,14)&"01",MID(-(1%&$A2),6,14)&"001")&REPT(0,19-LEN(IF(MOD(LEN(MID(-(1%&$A2),6,14)),2),MID(-(1%&$A2),6,14)&"01",MID(-(1%&$A2),6,14)&"001"))),商品和服务分类编码!L:L,1,0)),FALSE,TRUE)，附件中有关于公式的分解说明，希望能通过VBA代码来实现。

谢谢！

YZC51

请参考
Sub 条件格式()
    Range("A2:A15").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ISNA(VLOOKUP(LEFT(MID(-(1%&$A2),6,14)&""01""&REPT(0,15),19),ss,1,0))=FALSE"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

YZC51

简化下
Sub tjgs()
    Cells.FormatConditions.Delete
    mr = Cells(Rows.Count, 1).End(3).Row
    With Range("A2:A" & mr).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ISNA(VLOOKUP(LEFT(MID(-(1%&$A2),6,14)&""01""&REPT(0,15),19),ss,1,0))=FALSE"
        Selection.FormatConditions(1).Interior.ColorIndex = 4
    End With
End Sub

larer

YZC51 发表于 2019-11-5 17:24
请参考
Sub 条件格式()
    Range("A2:A15").Select

larer

条件格式的公式看着很费劲.如果用代码判断的话,应该是:
for i = 2 to r
if val(replace(.cells(i,"a").value,"107901"),"")<>0 then
.cells(i,"a").interior.color = 255
exit for
end if
next

mystic_hjj

非常感谢各位大侠们的帮助！我去研究下代码的含义。

mystic_hjj

YZC51 发表于 2019-11-5 17:50
简化下
Sub tjgs()
    Cells.FormatConditions.Delete

大侠你好，我运行了下你的代码，好像没有实现我的需求，sheet1表中的编码底纹都变颜色了，可能是我没把需求描写清楚。
我的需求为：在“sheet1”表中A列里用户输入固定19位长度的有效商品分类编码，什么是有效的商品编码，就是这个编码必需是最细分的编码，再往下数字都是0了，编码有规则，第一位是1，后面都是2位、2位的，如下图黄色底纹编码就不是最细分编码，后面还有“条”编码10，我发现我的条件格式中的公式还有缺陷的，我的想法是先提取编码中不含最右边0的有效数字，然后右边补上01后补充0到19位，形成一个新的编码，再把这个新的编码去“商品和服务分类编码”表中的L列中去查找，如果有这个编码，说明输入的编码不是最下一级的编码，然后单元格颜色标红色提示有问题。但如果最右边两位编码是10或20等整数的话，MID(-(1%&$A2),6,14)公式会少取一个0，导致再加上01后恢复19位编码有误，不知道还有没有更好的公式或代码来实现。

YZC51

mystic_hjj 发表于 2019-11-5 21:49
大侠你好，我运行了下你的代码，好像没有实现我的需求，sheet1表中的编码底纹都变颜色了，可能是我没把需 ...

最好上传有条件格式的附件，以方便测试！

YZC51

mystic_hjj 发表于 2019-11-5 21:49
大侠你好，我运行了下你的代码，好像没有实现我的需求，sheet1表中的编码底纹都变颜色了，可能是我没把需 ...

请参考
=ISNA(VLOOKUP(LEFT(=MID(MID(-(1%&A3),6,9)&"0",1,9)&"01"&REPT(0,15),19),ss,1,0))=FALSE

YZC51

我不是大侠，还是小学生，正在学习！
格式公式这样如何？！

Sub tjgs()
    Sheet1.Select
    Cells.FormatConditions.Delete
    mr = Cells(Rows.Count, 1).End(3).Row
    With Range("A2:A" & mr).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ISNA(VLOOKUP(LEFT(MID(MID(-(1%&A2),6,19)&REPT(0,MOD(LEN(MID(-(1%&A2),6,19))-1,2)),1,19)&""01""&REPT(0,16),19),ss,1,0))=FALSE"
        Selection.FormatConditions(1).Interior.ColorIndex = 4
    End With
End Sub