彰化一整天的論壇

 找回密碼
 立即註冊
查看: 370|回復: 0

【轉貼】VBA实现单元格条件格式的属性

[複製鏈接]
發表於 2017-7-8 21:05:33 | 顯示全部樓層 |閱讀模式
  1. Sub Hold_FormatConditions_Result()
  2. '转化条件格式成立,保留单元格条件格式属性的结果
  3. '1、单元格内部颜色属性
  4. '2、单元格字体属性
  5. '3、单元格边框样式属性
  6. '4、单元格底纹样式属性
  7. On Error Resume Next '避免没有条件格式的单元格
  8. Application.ScreenUpdating = False
  9.     Dim s_Operator(8) '存放操作符的数组
  10.     Dim Rng As Range, t_Rng As Range
  11.     Dim t_Rng_Val '含条件格式单元格的值
  12.     Dim Operator_sTr% '操作符类型对应的序号
  13.     Dim V_Fc_1, V_Fc_2 '表达式1、2中的结果
  14.     Dim t_V_Fc_a, t_V_Fc_b '临时变量
  15.     Dim s_Strs, s_Str '操作符
  16.     Dim ans As Boolean '判断条件成立与否的变量
  17.     Dim Con%, n%, i%
  18.     Dim s1 As Object '条件格式中的单元格字体
  19.     Dim s2 As Object '条件格式中的单元格内部
  20.     Dim s3 As Object '条件格式中的单元格边框
  21.     s_Operator(1) = "=And(vCell>=For1,vCell<=For2)"    'Between
  22.     s_Operator(2) = "=Not(And(vCell>=For1,vCell<=For2))"       'NotBetween
  23.     s_Operator(3) = "=vCell=For1"               '=
  24.     s_Operator(4) = "=vCell<>For1"              '<>
  25.     s_Operator(5) = "=vCell>For1"               '>
  26.     s_Operator(6) = "=vCell<For1"               '<
  27.     s_Operator(7) = "=vCell>=For1"              '>=
  28.     s_Operator(8) = "=vCell<=For1"              '<=
  29.     Set Rng = Cells.SpecialCells(xlCellTypeAllFormatConditions)
  30.     For Each t_Rng In Rng
  31.         n = t_Rng.FormatConditions.Count '获取含单元格的条件格式总数
  32.         If n > 0 Then
  33.             Con = 0
  34.             For i = n To 1 Step -1
  35.                 With t_Rng
  36.                     t_Rng.Select '此语句是为了调试方便留下的,可以根据情况删除
  37.                     If .FormatConditions(i).Type = 1 Then '条件单元格为值类型
  38.                         t_Rng_Val = t_Rng.Value '取得含条件格式单元格的值
  39.                         Operator_sTr = .FormatConditions(i).Operator '返回该条件格式的操作符
  40.                         '返回该条件格式中的条件表达式1
  41.                         V_Fc_1 = Application.Evaluate(.FormatConditions(i).Formula1)
  42.                         '操作符为介于或者不介于
  43.                         If Operator_sTr = 1 Or Operator_sTr = 2 Then
  44.                          '返回该条件格式中的条件表达式2
  45.                             V_Fc_2 = Application.Evaluate(.FormatConditions(i).Formula2)
  46.                             '单元格值、条件格式表达1的值、条件格式表达2的值是不为数值类型
  47.                             If Not (IsNumeric(t_Rng_Val)) Or Not (IsNumeric(V_Fc_1)) Or Not (IsNumeric(V_Fc_2)) Then
  48.                                 '为空值,则转换为 "" 类型
  49.                                 If IsEmpty(t_Rng_Val) Then t_Rng_Val = ""
  50.                                 '为数值,则转换为字符类型
  51.                                 If IsNumeric(t_Rng_Val) Then t_Rng_Val = CStr(t_Rng_Val)
  52.                                 '表达式1为空值,则转换为 "" 类型
  53.                                 If IsEmpty(V_Fc_1) Then V_Fc_1 = ""
  54.                                 '表达式1为数值,则转换为字符类型
  55.                                 If IsNumeric(V_Fc_1) Then V_Fc_1 = CStr(V_Fc_1)
  56.                                 '表达式2为空值,则转换为 "" 类型
  57.                                 If IsEmpty(V_Fc_2) Then V_Fc_2 = ""
  58.                                 '表达式2为空值,则转换为字符类型
  59.                                 If IsNumeric(V_Fc_2) Then V_Fc_2 = CStr(V_Fc_2)
  60.                             Else
  61.                                 If IsEmpty(t_Rng_Val) Then t_Rng_Val = 0
  62.                                 If IsEmpty(V_Fc_1) Then V_Fc_1 = 0
  63.                                 If IsEmpty(V_Fc_2) Then V_Fc_2 = 0
  64.                             End If
  65.                   '表达式1、表达式2的比较
  66.                             If V_Fc_1 > V_Fc_2 Then
  67.                                 t_V_Fc_a = V_Fc_2
  68.                                 t_V_Fc_b = V_Fc_1
  69.                             Else
  70.                                 t_V_Fc_a = V_Fc_1
  71.                                 t_V_Fc_b = V_Fc_2
  72.                             End If
  73.                         Else '操作符序号大于2的情况
  74.                             t_V_Fc_a = V_Fc_1
  75.                             If t_Rng_Val < V_Fc_1 Then
  76.                             '单元格值小于条件格式的设置的值,即条件成立的情况
  77.                                 ans = True
  78.                                 Con = i
  79.                                 Exit For
  80.                             End If
  81.                         End If
  82.                         '单元格值、条件格式表达式1、条件格式表达式2的返回值:为文本时,将小写英文字符转换为大写英文字符
  83.                         If Application.WorksheetFunction.IsText(t_Rng_Val) Then t_Rng_Val = """" & UCase(t_Rng_Val) & """"
  84.                         If Application.WorksheetFunction.IsText(t_V_Fc_a) Then t_V_Fc_a = """" & UCase(t_V_Fc_a) & """"
  85.                         If Application.WorksheetFunction.IsText(t_V_Fc_b) Then t_V_Fc_b = """" & UCase(t_V_Fc_b) & """"
  86.                         '返回s_Str字符串中的操作符为:可转换一个对象或者一个值做替换操作
  87.                         s_Strs = s_Operator(Operator_sTr)
  88.                         s_Str = Replace(s_Strs, "For1", t_V_Fc_a)
  89.                         s_Str = Replace(s_Str, "For2", t_V_Fc_b)
  90.                         s_Str = Replace(s_Str, "vCell", t_Rng_Val)
  91.                         '将s_Str 转换为值出现错误时
  92.                         If Application.WorksheetFunction.IsError(Application.Evaluate(s_Str)) Then
  93.                         Else '转换成功。则条件格式成立
  94.                             ans = Application.Evaluate(s_Str)
  95.                         End If

  96.                     Else '条件格式为公式
  97.                         If Application.WorksheetFunction.IsError(Application.Evaluate(.FormatConditions(i).Formula1)) Then
  98.                         Else
  99.                             ans = Application.Evaluate(.FormatConditions(i).Formula1)
  100.                             Con = i
  101.                         End If
  102.                     End If
  103.                 End With
  104.             Next
  105.             If Con > 0 Then
  106.                 Set s1 = t_Rng.FormatConditions(Con).Font '条件格式中设置的字体
  107.                 Set s2 = t_Rng.FormatConditions(Con).Interior '条件格式中设置的单元格内部
  108.                 Set s3 = t_Rng.FormatConditions(Con).Borders '条件格式中设置的单元格边框
  109.                 With t_Rng.Font '条件格式成立的单元格字体
  110.                     .Bold = s1.Bold '加粗
  111.                     .Italic = s1.Italic '斜体
  112.                     .Underline = s1.Underline '下划线
  113.                     .Strikethrough = s1.Strikethrough '删除线
  114.                     .ColorIndex = s1.ColorIndex '字体颜色索引号
  115.                 End With
  116.                 With t_Rng
  117.                     .Interior.ColorIndex = s2.ColorIndex  '单元格内部颜色索引号
  118.                     .Interior.Pattern = s2.Pattern '单元格内部图案
  119.                     .Interior.PatternColorIndex = s2.PatternColorIndex '单元格内部图案颜色索引号
  120.                     .Borders.LineStyle = s3.LineStyle '单元格边框线类型
  121.                     .Borders.ColorIndex = s3.ColorIndex '单元格边框线颜色索引号
  122.                     .Borders.Weight = s3.Weight '边框线宽度(粗细)
  123.                     .FormatConditions.Delete '删除条件格式
  124.                 End With
  125.             End If
  126.         End If
  127.     Next
  128.     Application.ScreenUpdating = False
  129. End Sub   
複製代碼
資料來源: http://club.excelhome.net/forum. ... able&tid=203856
回復

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-12-16 07:52 , Processed in 0.101851 second(s), 19 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表