VBA实现单元格条件格式的属性、方法（2）

接上帖：http://www.excel-cn.com/tip/325-cn.html
8、用VBA代码转化条件格式为真的属性值为单元格的属性值
Sub Hold_FormatConditions_Result()
'转化条件格式成立，保留单元格条件格式属性的结果
'1、单元格内部颜色属性
'2、单元格字体属性
'3、单元格边框样式属性
'4、单元格底纹样式属性
On Error Resume Next  '避免没有条件格式的单元格
Application.ScreenUpdating = False
Dim s_Operator(8)  '存放操作符的数组
Dim Rng As Range, t_Rng As Range
Dim t_Rng_Val  '含条件格式单元格的值
Dim Operator_sTr%  '操作符类型对应的序号
Dim V_Fc_1, V_Fc_2  '表达式1、2中的结果
Dim t_V_Fc_a, t_V_Fc_b  '临时变量
Dim s_Strs, s_Str  '操作符
Dim ans As Boolean  '判断条件成立与否的变量
Dim Con%, n%, i%
Dim s1 As Object  '条件格式中的单元格字体
Dim s2 As Object  '条件格式中的单元格内部
Dim s3 As Object  '条件格式中的单元格边框
s_Operator(1) = "=And(vCell>=For1,vCell=For1,vCellFor1"  '
s_Operator(5) = "=vCell>For1"  '>
s_Operator(6) = "=vCell=For1"  '>=
s_Operator(8) = "=vCell 0 Then
Con = 0
For i = n To 1 Step -1
With t_Rng
t_Rng.Select  '此语句是为了调试方便留下的，可以根据情况删除
If .FormatConditions(i).Type = 1 Then  '条件单元格为值类型
t_Rng_Val = t_Rng.Value  '取得含条件格式单元格的值
Operator_sTr = .FormatConditions(i).Operator  '返回该条件格式的操作符
  '返回该条件格式中的条件表达式1
V_Fc_1 = Application.Evaluate(.FormatConditions(i).Formula1)
  '操作符为介于或者不介于
If Operator_sTr = 1 Or Operator_sTr = 2 Then
  '返回该条件格式中的条件表达式2
V_Fc_2 = Application.Evaluate(.FormatConditions(i).Formula2)
  '单元格值、条件格式表达1的值、条件格式表达2的值是不为数值类型
If Not (IsNumeric(t_Rng_Val)) Or Not (IsNumeric(V_Fc_1)) Or Not (IsNumeric(V_Fc_2)) Then
  '为空值，则转换为 "" 类型
If IsEmpty(t_Rng_Val) Then t_Rng_Val = ""
  '为数值，则转换为字符类型
If IsNumeric(t_Rng_Val) Then t_Rng_Val = CStr(t_Rng_Val)
  '表达式1为空值，则转换为 "" 类型
If IsEmpty(V_Fc_1) Then V_Fc_1 = ""
  '表达式1为数值，则转换为字符类型
If IsNumeric(V_Fc_1) Then V_Fc_1 = CStr(V_Fc_1)
  '表达式2为空值，则转换为 "" 类型
If IsEmpty(V_Fc_2) Then V_Fc_2 = ""
  '表达式2为空值，则转换为字符类型
If IsNumeric(V_Fc_2) Then V_Fc_2 = CStr(V_Fc_2)
Else
If IsEmpty(t_Rng_Val) Then t_Rng_Val = 0
If IsEmpty(V_Fc_1) Then V_Fc_1 = 0
If IsEmpty(V_Fc_2) Then V_Fc_2 = 0
End If  '表达式1、表达式2的比较
If V_Fc_1 > V_Fc_2 Then
t_V_Fc_a = V_Fc_2
t_V_Fc_b = V_Fc_1
Else
t_V_Fc_a = V_Fc_1
t_V_Fc_b = V_Fc_2
End If
Else  '操作符序号大于2的情况
t_V_Fc_a = V_Fc_1
If t_Rng_Val  0 Then
Set s1 = t_Rng.FormatConditions(Con).Font  '条件格式中设置的字体
Set s2 = t_Rng.FormatConditions(Con).Interior  '条件格式中设置的单元格内部
Set s3 = t_Rng.FormatConditions(Con).Borders  '条件格式中设置的单元格边框
With t_Rng.Font  '条件格式成立的单元格字体
.Bold = s1.Bold  '加粗
.Italic = s1.Italic  '斜体
.Underline = s1.Underline  '下划线
.Strikethrough = s1.Strikethrough  '删除线
.ColorIndex = s1.ColorIndex  '字体颜色索引号
End With
With t_Rng
.Interior.ColorIndex = s2.ColorIndex  '单元格内部颜色索引号
.Interior.Pattern = s2.Pattern  '单元格内部图案
.Interior.PatternColorIndex = s2.PatternColorIndex  '单元格内部图案颜色索引号
.Borders.LineStyle = s3.LineStyle  '单元格边框线类型
.Borders.ColorIndex = s3.ColorIndex  '单元格边框线颜色索引号
.Borders.Weight = s3.Weight  '边框线宽度（粗细）
.FormatConditions.Delete  '删除条件格式
End With
End If
End If
Next
Application.ScreenUpdating = False
End Sub
  本帖的程序测试在Excel2003下通过。引用的帮助内容出自Excel2003VBA中。希望本帖起到资料或者工具的作用，既方便自己的快速查阅，也方便了有此需求的朋友。
转载自：Aeolian-Vox(ExcelHome )