接上帖：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<=For2)" 'Between
s_Operator(2) = "=Not(And(vCell>=For1,vCell<=For2))" 'NotBetween
s_Operator(3) = "=vCell=For1" '=
s_Operator(4) = "=vCell<>For1" '<>
s_Operator(5) = "=vCell>For1" '>
s_Operator(6) = "=vCell<For1" '<
s_Operator(7) = "=vCell>=For1" '>=
s_Operator(8) = "=vCell<=For1" '<=
Set Rng = Cells.SpecialCells(xlCellTypeAllFormatConditions)
For Each t_Rng In Rng
n = t_Rng.FormatConditions.Count '获取含单元格的条件格式总数
If n > 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 < V_Fc_1 Then
'单元格值小于条件格式的设置的值，即条件成立的情况
ans = True
Con = i
Exit For
End If
End If
'单元格值、条件格式表达式1、条件格式表达式2的返回值：为文本时，将小写英文字符转换为大写英文字符
If Application.WorksheetFunction.IsText(t_Rng_Val) Then t_Rng_Val = """" & UCase(t_Rng_Val) & """"
If Application.WorksheetFunction.IsText(t_V_Fc_a) Then t_V_Fc_a = """" & UCase(t_V_Fc_a) & """"
If Application.WorksheetFunction.IsText(t_V_Fc_b) Then t_V_Fc_b = """" & UCase(t_V_Fc_b) & """"
'返回s_Str字符串中的操作符为:可转换一个对象或者一个值做替换操作
s_Strs = s_Operator(Operator_sTr)
s_Str = Replace(s_Strs, "For1", t_V_Fc_a)
s_Str = Replace(s_Str, "For2", t_V_Fc_b)
s_Str = Replace(s_Str, "vCell", t_Rng_Val)
'将s_Str 转换为值出现错误时
If Application.WorksheetFunction.IsError(Application.Evaluate(s_Str)) Then
Else '转换成功。则条件格式成立
ans = Application.Evaluate(s_Str)
End If
Else '条件格式为公式
If Application.WorksheetFunction.IsError(Application.Evaluate(.FormatConditions(i).Formula1)) Then
Else
ans = Application.Evaluate(.FormatConditions(i).Formula1)
Con = i
End If
End If
End With
Next
If Con > 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 )
