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