使条件格式固定不变

Question

使条件格式固定不变

excelvbaexcel-2003

12

有没有办法在Excel中将条件格式转换为静态格式？

我正在尝试将Excel表格的一系列内容导出到一个新的工作簿中，使其外观相同但不包含公式、链接等。问题在于，我使用了依赖于导出范围之外计算结果的条件格式。

我已经尝试将工作簿保存为.html文件，奇怪的是，这种格式在IE中可以显示，但重新在Excel中打开时却无法显示。

- Martin

7个回答

5

这种方式似乎效果不错。我只针对背景颜色实现了它。

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

- pooroldpedro

1

这很完美，比现代 Excel 中的其他解决方案简单得多！如果需要，还可以轻松适应其他属性。请注意，它也会删除范围内的合并单元格。 - Chris Schaller

5

我建议您采用一种更简单的方法，这种方法始终有效。我曾经尝试过使用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.)

在将Excel工作簿保存为HTML格式的过程中，程序会“剥离”所有条件格式并使其明确（绝对）。但是，请注意，此过程也会将公式转换为值进行保存。

- Ashish Anand

你可以尝试从HTML浏览器中复制并粘贴->特殊格式。如果这不起作用，可以从浏览器中复制并粘贴到一个空的Excel工作表中，然后再复制和粘贴格式。 - jlear

@jlear 在 Excel 中对溢出文本设置了 display: none。复制时请注意。 - Monday Fatigue

3

我很讨厌人们说“嘿，你为什么不用另一种方式完成整个事情”，但我还是想提供一个方法：以前我想这么做的时候，我首先复制整个工作表，然后将公式作为值粘贴（不要移动它们的位置）。这将冻结条件格式，也意味着重新计算工作簿不会使值变得不再适合其上的格式。

如果这行不通，belisarius的代码看起来很棒。

- Chris Rae

如果不违反其他操作者的需求，那就一点问题都没有。+1 - Dr. belisarius

1

谢谢 - 复制数值是计划的一部分。这里的一个问题是我只需要表格的一部分并删除其他行/列，但条件链接到该部分之外的单元格。另一个（较小的）问题是复制数值会破坏文本单元格中的任何子单元格格式。 - Martin

我刚在 Excel 2010 中尝试了一下，似乎不起作用。您能详细说明一下将带有条件格式的单元格范围复制到另一个工作表的步骤吗？当我粘贴值时，格式完全丢失，当我粘贴 值和源格式 时，条件格式 规则也被复制到新工作表中 :(. - Marcus Mangelsdorf

抱歉，实际上 - 我没有表达清楚。我已经编辑了答案。 - Chris Rae

1

我已经整合了Belisarius和Cameron Forward的补充内容。您需要选择要冻结的区域（选择较大的区域可能需要一些时间）。我注意到，如果单元格中存在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 https://dev59.com/d2445IYBdhLWcg3wytMU
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 https://dev59.com/d2445IYBdhLWcg3wytMU

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

- zweettooth

0

我从excel.tips.com上学到了这个方法，使其适用于Excel 2010，并为gcl的Belisarius帖子版本进行了调整。在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

它可以正确地使公式向下和向右传播。

- Cameron Forward

当我这样做时，我一直收到“变量未定义”的错误。 - Lorenzo

@Lorenzo：在代码开始处添加“Dim f3 As String”以定义f3变量。另外请注意，如果您使用非英语环境的Excel，则必须“翻译”来自条件格式（CF）的公式。（有关如何进行翻译，请参见此答案） - Marcus Mangelsdorf

0

感谢Belisarius提供非常有用的答案！但是，在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 https://dev59.com/d2445IYBdhLWcg3wytMU
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 https://dev59.com/d2445IYBdhLWcg3wytMU

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

- gcl

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Dr. belisarius · Accepted Answer

以下想法取自这里，但已修改以适应一些新的条件格式结构和您的需求。

它的工作原理是：给定一个带有一些条件格式的工作簿（复制您的工作簿），在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