当前位置： 文江博客话题详情

使条件格式静态化

发布于 2024-10-12 08:41:36 字数 180 浏览 6 评论 0原文

有什么方法可以将 Excel 中的条件格式转换为静态格式吗？

我正在尝试将一系列 Excel 工作表导出到新的工作簿，具有相同的外观，但没有公式、链接等。这里的问题是我的条件格式依赖于导出范围之外的计算。

我尝试将工作簿保存为 .html，奇怪的是，格式在 IE 中显示，但在 Excel 中重新打开时却没有显示。

原文

Is there any way to convert conditional formatting to static formatting in Excel?

I'm trying to export a range of a Excel Sheet to a new Workbook, with identical appearance but no formulas, links, etc. The problem here is that I have conditional formatting that relies on calculations outside exported range.

I've tried saving the workbook to .html, oddly enough the formatting shows in IE but not when reopening it in Excel.

如果你对这篇内容有疑问，欢迎到本站社区发帖提问 参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论， 你可以免费 注册 一个本站的账号。

评论（7）

空城仅有旧梦在 2024-10-19 08:41:36

以下想法是取自此处，但经过修改以适应一些新的条件格式结构和您的需求。

它的工作原理如下：给定一个具有某些条件格式的工作簿（复制您的工作簿），将要从条件格式转换为直接格式的单元格范围放入 Sub a() 中，然后运行宏。之后，只需手动删除条件格式即可！

抱歉代码长度......生活有时就是这样:(

Option Explicit
Sub a()

Dim iconditionno As Integer
Dim rng, rgeCell As Range
Set rng = Range("A1:A10")

For Each rgeCell In rng

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
       End If
   End If
Next rgeCell

End Sub
Private Function ConditionNo(ByVal rgeCell As Range) As Integer

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression
            If Application.Evaluate(objFormatCondition.Formula1) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function

The following idea was taken from here, although modified to fit some new conditional formatting structures and your needs.

It works like this: Given a workbook with some conditional formatting (make a copy of yours), you put in Sub a() the range of cells you want to transform from conditional to straight formatting, and run the macro. After that, just delete manually the conditional formats, and presto!

Sorry about the code length ... life is sometimes like this :(

Option Explicit
Sub a()

Dim iconditionno As Integer
Dim rng, rgeCell As Range
Set rng = Range("A1:A10")

For Each rgeCell In rng

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
       End If
   End If
Next rgeCell

End Sub
Private Function ConditionNo(ByVal rgeCell As Range) As Integer

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression
            If Application.Evaluate(objFormatCondition.Formula1) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function
回复 原文
谈情不如逗狗 2024-10-19 08:41:36

这种方法似乎效果很好。我只将其实现为背景颜色。

Sub FixColor()
    Dim r
    For Each r In Selection
        r.Interior.Color = r.DisplayFormat.Interior.Color
    Next r
    Selection.FormatConditions.Delete
End Sub

This approach seems to work well. I've only implemented it for background colours.

Sub FixColor()
    Dim r
    For Each r In Selection
        r.Interior.Color = r.DisplayFormat.Interior.Color
    Next r
    Selection.FormatConditions.Delete
End Sub
回复 原文
攀登最高峰 2024-10-19 08:41:36

我建议您采用一种更简单且始终有效的方法。
我也很努力地尝试过VBA，但是太难了，所以我中途就放弃了。

要将条件格式转换为静态，我们首先将 Excel 转换为 Html（网页），然后再转换回 Excel。请遵循以下方法。

1. Load the workbook that contains your conditional formatting.
2. Save the workbook as an HTML file(as webpage). 
(Press F12, specify the HTML format, and give the workbook a different name.)
3. Restart Excel.
4. Load into Excel the HTML file you saved in step 2.
5. Save the workbook as an Excel workbook. 
(Press F12, specify an Excel workbook format, and give the workbook a different name.)

在以 HTML 格式保存 Excel 工作簿的过程中，程序“剥离”所有条件格式并使其显式（绝对）。但是，您应该意识到，此过程也会对您的公式执行相同的操作，而是将所有内容保存为值。

I am suggesting you a much easier approach which will work all the time.
I also tried hard with VBA but it was so difficult that I left in middle.

To convert conditional formatting to static,we will first convert Excel to Html(webpage) and then back to excel. Please follow below approach.

1. Load the workbook that contains your conditional formatting.
2. Save the workbook as an HTML file(as webpage). 
(Press F12, specify the HTML format, and give the workbook a different name.)
3. Restart Excel.
4. Load into Excel the HTML file you saved in step 2.
5. Save the workbook as an Excel workbook. 
(Press F12, specify an Excel workbook format, and give the workbook a different name.)

In the process of saving the Excel workbook in HTML format, the program "strips" all the conditional formatting and makes it explicit (absolute). You should be aware, however, that this process also does the same with your formulas, saving everything as a value, instead.

回复 原文
流心雨 2024-10-19 08:41:36

我讨厌人们说“嘿，你为什么不以其他方式做这件事”，但我会把它扔在那里：当我过去想做这件事时，我已经做到了首先复制相关的整个工作表，然后将公式复制并粘贴为值（根本不移动其位置）。这显然会冻结条件格式，但也意味着重新计算工作簿不会留下不再适合其上的格式的值。

如果这不起作用，贝利萨留的代码看起来很棒。

I hate it when people say "hey, why aren't you doing that whole thing this other way", but I'll just throw it out there: when I've wanted to do this in the past, I've done it by first copying the entire worksheet in question and then copying and pasting the formulas as values (without moving their location at all). This will freeze the conditional formatting obviously, but also means that recalculating the workbook won't leave you with values that are no longer appropriate for the formatting that's sitting on them.

If this doesn't work, belisarius' code looks great.

回复 原文
虫児飞 2024-10-19 08:41:36

我把贝利撒留和卡梅伦·福沃德的补充放在一起。您必须选择要冻结的区域（大量选择可能需要一段时间）。我注意到如果单元格上存在 Excel 错误，可能会导致异常，但除此之外，这在 Excel 2010 上运行得很好。顺便说一句，谢谢大家！

Option Explicit

Sub FreezeConditionalFormattingOnSelection()
    Call FreezeConditionalFormatting(Selection)
    Selection.FormatConditions.Delete
End Sub

Public Function FreezeConditionalFormatting(Rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem   (a) be a function taking target range as an argument, and
Rem   (b) to cancel any multiple selection before processing in order to work around a bug
Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem         returns the conditional formatting on the first cell in that selection!
Rem   (c) return number of cells that it modified.

Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range

Set rgeOldSelection = Selection 'new

nCFCells = 0
For Each rgeCell In Rng
    rgeCell.Select  'new

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex

           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
           nCFCells = nCFCells + 1
       End If
   End If
Next rgeCell

rgeOldSelection.Select 'new

FreezeConditionalFormatting = nCFCells
End Function

Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition
Dim f3 As String

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression

            f3 = objFormatCondition.Formula1
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlR1C1, RelativeTo:=objFormatCondition.AppliesTo.Cells(1, 1))
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlAbsolute, RelativeTo:=rgeCell)
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlA1)

            If Application.Evaluate(f3) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function

I've put together Belisarius and Cameron Forward's addition. You have to select the area you would like to freeze (large selections might take a while). I've noticed if there are excel errors on cells it might cause an exception, but otherwise this is working great on Excel 2010. By the way, thank you all!

Option Explicit

Sub FreezeConditionalFormattingOnSelection()
    Call FreezeConditionalFormatting(Selection)
    Selection.FormatConditions.Delete
End Sub

Public Function FreezeConditionalFormatting(Rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem   (a) be a function taking target range as an argument, and
Rem   (b) to cancel any multiple selection before processing in order to work around a bug
Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem         returns the conditional formatting on the first cell in that selection!
Rem   (c) return number of cells that it modified.

Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range

Set rgeOldSelection = Selection 'new

nCFCells = 0
For Each rgeCell In Rng
    rgeCell.Select  'new

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex

           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
           nCFCells = nCFCells + 1
       End If
   End If
Next rgeCell

rgeOldSelection.Select 'new

FreezeConditionalFormatting = nCFCells
End Function

Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition
Dim f3 As String

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression

            f3 = objFormatCondition.Formula1
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlR1C1, RelativeTo:=objFormatCondition.AppliesTo.Cells(1, 1))
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlAbsolute, RelativeTo:=rgeCell)
            f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlA1)

            If Application.Evaluate(f3) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function
回复 原文
仄言 2024-10-19 08:41:36

感谢贝利萨留提供了非常有用的答案！然而，它在 Excel 2003 中遇到了一个错误，即在多个/扩展选择中的任何单元格上查询条件格式公式会返回该选择中第一个单元格的公式！为了解决这个问题，我必须在开始时取消任何选择并在最后恢复它。我还将他的子例程更改为一个函数，该函数接受一个范围并返回修改的单元格数量，并添加了一个包装子例程，将其应用于当前选择并删除任何条件格式（因为不再需要），因此您不再需要修改它以硬编码您的目标范围。

Option Explicit

Sub FreezeConditionalFormattingOnSelection()
    Call FreezeConditionalFormatting(Selection)
    Selection.FormatConditions.Delete
End Sub

Public Function FreezeConditionalFormatting(rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem   (a) be a function taking target range as an argument, and
Rem   (b) to cancel any multiple selection before processing in order to work around a bug
Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem         returns the conditional formatting on the first cell in that selection!
Rem   (c) return number of cells that it modified.

Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range

Set rgeOldSelection = Selection 'new

nCFCells = 0
For Each rgeCell In rng
    rgeCell.Select  'new

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
           nCFCells = nCFCells + 1
       End If
   End If
Next rgeCell

rgeOldSelection.Select 'new

FreezeConditionalFormatting = nCFCells
End Function

Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression
            If Application.Evaluate(objFormatCondition.Formula1) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function

Thanks to Belisarius for the very useful answer! However, it runs into a bug in Excel 2003 where querying the conditional formatting formula on any cell in a multiple/extended selection returns the formula for the first cell in that selection! To work around this I had to cancel any selection at the beginning and restore it at the end. I also changed his subroutine into a function that takes a range and returns the number of cells modified, and added a wrapper subroutine that applies it to the current selection and deletes any conditional formatting (since it's no longer needed), so you no longer need to modify it to hard-code your target range.

Option Explicit

Sub FreezeConditionalFormattingOnSelection()
    Call FreezeConditionalFormatting(Selection)
    Selection.FormatConditions.Delete
End Sub

Public Function FreezeConditionalFormatting(rng As Range)
Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
Rem Modified 2012-04-20 by gcl to:
Rem   (a) be a function taking target range as an argument, and
Rem   (b) to cancel any multiple selection before processing in order to work around a bug
Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
Rem         returns the conditional formatting on the first cell in that selection!
Rem   (c) return number of cells that it modified.

Dim iconditionno As Integer
Dim rgeCell As Range
Dim nCFCells As Integer
Dim rgeOldSelection As Range

Set rgeOldSelection = Selection 'new

nCFCells = 0
For Each rgeCell In rng
    rgeCell.Select  'new

   If rgeCell.FormatConditions.Count <> 0 Then
       iconditionno = ConditionNo(rgeCell)
       If iconditionno <> 0 Then
           rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
           rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
           nCFCells = nCFCells + 1
       End If
   End If
Next rgeCell

rgeOldSelection.Select 'new

FreezeConditionalFormatting = nCFCells
End Function

Private Function ConditionNo(ByVal rgeCell As Range) As Integer
Rem posted by http://stackoverflow.com/users/353410/belisarius
Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static

Dim iconditionscount As Integer
Dim objFormatCondition As FormatCondition

    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
           Case xlCellValue
               Select Case objFormatCondition.Operator
                   Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                           Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                   Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                           ConditionNo = iconditionscount

                  If ConditionNo > 0 Then Exit Function
              End Select

          Case xlExpression
            If Application.Evaluate(objFormatCondition.Formula1) Then
               ConditionNo = iconditionscount
               Exit Function
            End If
       End Select

    Next iconditionscount
End Function

Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean

   If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
   If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)

   If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
   If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)

   Select Case sOperator
      Case "=": Compare = (vValue1 = vValue2)
      Case "<": Compare = (vValue1 < vValue2)
      Case "<=": Compare = (vValue1 <= vValue2)
      Case ">": Compare = (vValue1 > vValue2)
      Case ">=": Compare = (vValue1 >= vValue2)
      Case "<>": Compare = (vValue1 <> vValue2)
   End Select
End Function
回复 原文
固执像三岁 2024-10-19 08:41:36

我在 excel.tips.com 上找到了这个附加内容，使其适用于 Excel 2010，并针对 Belisarius 帖子的 gcl 版本进行了调整。将此行替换为 xlExpression Case 下：

If Application.Evaluate(objFormatCondition.Formula1) Then

这样：

f3 = objFormatCondition.Formula1
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlR1C1, RelativeTo:=objFormatCondition.AppliesTo.Cells(1, 1))
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlAbsolute, RelativeTo:=rgeCell)
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlA1)
If Application.Evaluate(f3) Then

它使公式正确地向下和横向传播。

I picked up this addition over at excel.tips.com to make this work for Excel 2010 and adapted it for gcl's version of Belisarius' post. Substitute this line under the xlExpression Case:

If Application.Evaluate(objFormatCondition.Formula1) Then

With this:

f3 = objFormatCondition.Formula1
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlR1C1, RelativeTo:=objFormatCondition.AppliesTo.Cells(1, 1))
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlAbsolute, RelativeTo:=rgeCell)
f3 = Application.ConvertFormula(Formula:=f3, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlA1)
If Application.Evaluate(f3) Then

It makes the formula propogate down and across correctly.

回复 原文
~没有更多了~

关于作者

红ご颜醉

暂无简介

0 文章
0 评论
25 人气
发私信

相关话题

更多

热门标签

操作系统 程序设计 IT运维 Linux系统管理 JavaScript 服务器应用 solaris C/C++ PHP Shell BSD Vue.js aix Oracle Python HTML 系统管理 HTML5 CSS 前端
更多

推荐作者

胡图图

文章 0 评论 0

zt006

文章 0 评论 0

z祗昰~

文章 0 评论 0

冰葑

文章 0 评论 0

野の

文章 0 评论 0

天空

文章 0 评论 0

更多

友情链接

文江博客
    我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站，即表示您同意使用 Cookies 和您的相关数据。
    原文