接上帖：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 = FalseEnd Sub         本帖的程序测试在Excel2003下通过。引用的帮助内容出自Excel2003VBA中。希望本帖起到资料或者工具的作用，既方便自己的快速查阅，也方便了有此需求的朋友。

转载自：Aeolian-Vox(ExcelHome )