VBA--条件格式

VBA–条件格式

1.设置条件格式

Sub SetRuleTest()
    Dim WSS1StartRow(2) As Integer
    Dim WSS1EndRow(2) As Integer
    Dim StartColumn(1) As Integer
    Dim EndColumn(1) As Integer
    Dim SpecRow As Integer
    Dim STRowOffset As Integer
    
    SpecRow = 2
    STRowOffset = 0
    
    WSS1StartRow(0) = 4
    WSS1StartRow(1) = 80
    
    WSS1EndRow(0) = 37
    WSS1EndRow(1) = 113
    
    StartColumn(0) = 40
    EndColumn(0) = 73
    
    Dim i
    Dim j
    Dim l
    Dim k
    
    For i = 0 To UBound(WSS1StartRow) - 1
        For j = 0 To UBound(StartColumn) - 1
            Call SetRules(WSS1StartRow(i), WSS1EndRow(i), StartColumn(j), EndColumn(j), SpecRow, 1, STRowOffset)
        Next j
        SpecRow = SpecRow + 1
        STRowOffset = STRowOffset + 1
    Next i
    
    ActiveWorkbook.Save
End Sub

Sub SetRules(StartRow As Integer, EndRow As Integer, StartColumn As Integer, EndColumn As Integer, SpecRow As Integer, WSSIndex As Integer, STRowOffset As Integer)
     
    Sheets("XXX").Select
        Dim i As Integer
        Dim j As Integer
        Dim cel
        Dim m
        Dim s
        For i = StartRow To EndRow
            For j = StartColumn To EndColumn
            
            cel = CSN(j) + CStr(i)
            m = CSN(j) + CStr(StartRow - 1)
            l = CSN(StartColumn - 1) + CStr(i)
            ActiveSheet.Range(cel).Select
            Selection.FormatConditions.Delete
            
            With Selection.FormatConditions.Add(Type:=xlCellValue, Operator:=xlNotBetween, Formula1:="-200", Formula2:="-1")
                With .Interior
                    .ColorIndex = 0
                End With
            End With
            
            s = "=IF(ISNUMBER(LOOKUP(1,0/((XXX" + CStr(WSSIndex) + "_ST_Spec!B2:B1000=" + l + ")*(XXX" + CStr(WSSIndex) + "_ST_Spec!C2:C1000=" + m + ")),XXX" + CStr(WSSIndex) + "_ST_Spec!A2:A1000))," + _
                  cel + ">OFFSET(XXX" + CStr(WSSIndex) + "_ST_Spec!D2," + CStr(STRowOffset) + ",LOOKUP(1,0/((XXX" + CStr(WSSIndex) + "_ST_Spec!B2:B1000=" + l + ")*(XXX" + CStr(WSSIndex) + "_ST_Spec!C2:C1000=" + m + ")),XXX" + CStr(WSSIndex) + "_ST_Spec!A2:A1000),1,1)+2,0)"
                With Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=s)
                    With .Interior
                        .Color = RGB(255, 0, 0)
                    End With
                End With
            
            s = "=IF(ISNUMBER(LOOKUP(1,0/((XXX" + CStr(WSSIndex) + "_ST_Spec!B2:B1000=" + l + ")*(XXX" + CStr(WSSIndex) + "_ST_Spec!C2:C1000=" + m + ")),XXX" + CStr(WSSIndex) + "_ST_Spec!A2:A1000))," + _
                  "AND(" + cel + "<=OFFSET(XXX" + CStr(WSSIndex) + "_ST_Spec!D2," + CStr(SpecRow - 2) + ",LOOKUP(1,0/((XXX" + CStr(WSSIndex) + "_ST_Spec!B2:B1000=" + l + ")*(XXX" + CStr(WSSIndex) + "_ST_Spec!C2:C1000=" + m + ")),XXX" + CStr(WSSIndex) + "_ST_Spec!A2:A1000),1,1)+2," + _
                  cel + ">OFFSET(XXX" + CStr(WSSIndex) + "_ST_Spec!D2," + CStr(STRowOffset) + ",LOOKUP(1,0/((XXX" + CStr(WSSIndex) + "_ST_Spec!B2:B1000=" + l + ")*(XXX" + CStr(WSSIndex) + "_ST_Spec!C2:C1000=" + m + ")),XXX" + CStr(WSSIndex) + "_ST_Spec!A2:A1000),1,1)),0)"
                With Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=s)
                    With .Interior
                        .Color = RGB(255, 255, 0)
                    End With
                End With
                
            s = "=IF(" + m + "=Spec!$E$1," + cel + ">Spec!$C$" + CStr(SpecRow) + "+2," + cel + ">Spec!$B$" + CStr(SpecRow) + "+2)"
                With Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=s)
                    With .Interior
                        .Color = RGB(255, 0, 0)
                    End With
                End With
                
            s = "=IF(" + m + "=Spec!$E$1," + cel + "<=Spec!$C$" + CStr(SpecRow) + "-2," + cel + "<=Spec!$B$" + CStr(SpecRow) + "-2)"
                With Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=s)
                    With .Interior
                        .Color = RGB(0, 176, 80)
                    End With
                End With
             
        Next
    Next
     

 End Sub
Private Function CSN(Col)

    Dim i, j, si, sj
    If IsNumeric(Col) Then
    j = Col Mod 26: i = (Col - j) / 26: If j = 0 Then j = 26: i = i - 1
    If i > 0 Then CSN = Chr(64 + i) & Chr(64 + j) Else CSN = Chr(64 + j)
    'Else
    'If Len(Col) = 1 Then sj = Col Else si = Mid(Col, 1, 1): sj = Mid(Col, 2, 1)
    'If si <> "" Then i = Asc(si) - 64
    'If sj <> "" Then j = Asc(sj) - 64
    'CSN = 26 * i + j
    End If

End Function

2.删除条件格式

Sub deleteRules()
    Dim StartRow(2) As Integer
    Dim EndRow(2) As Integer
    Dim StartColumn(2) As Integer
    Dim EndColumn(2) As Integer
    
    StartRow(0) = 4
    StartRow(1) = 80
   
    EndRow(0) = 37
    EndRow(1) = 113
   
    StartColumn(0) = 3
    StartColumn(1) = 77
   
    EndColumn(0) = 36
    EndColumn(1) = 110
    
    Sheets("XXX").Select
    Dim i
    Dim j
    Dim l
    Dim k
    For i = 0 To UBound(StartRow) - 1
        For j = 0 To UBound(StartColumn) - 1
            cel = CSN(StartColumn(j)) + CStr(StartRow(i)) + ":" + CSN(EndColumn(j)) + CStr(EndRow(i))
            ActiveSheet.Range(cel).Select
            Selection.FormatConditions.Delete
        Next j
    Next i
    ActiveWorkbook.Save
End Sub
  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 2
    评论
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值