VBA - 应用条件格式后获取实际单元格的 NumberFormat

Question

示例： 我们有具有常规格式的简单单元格。

让我们添加条件格式，将单元格的 NumberFormat 更改为

"# ##0.00"

。现在看起来像这样

问题是如何从 VBA 代码获取单元格的当前 NumberFormat？鉴于我需要实际显示的格式。

当我尝试

.NumberFormat

或

.DisplayFormat.NumberFormat

- 相同的结果=“一般”。 有没有办法获得正确的数字格式 -

"# ##0.00"

？

PS 我需要它的原因 - 我正在尝试制作一个 VBA 宏，它可以保存单元格当前的格式，但删除所有条件格式计算。

Answer 1

正如 @Ron Rosefeld 和 @FaneDuru 指出的那样 - 猜测唯一的解决方案是循环遍历所有格式条件并找到有效的一个。正如预期的那样，这非常棘手。

幸运的是，我找到了一个函数来确定哪个 CF 当前对于给定单元格（如果有）处于活动状态 - 来自 http://www.cpearson.com/excel/cfcolors.htm 的 ActiveCondition 函数。我修改了它并制作了 CFNumberFormat 函数来完成我想要的操作。代码如下。

示例：

另一个有效的概念 - 事实证明

Rng.FormatConditions(n).NumberFormat

始终返回本地数字格式（.NumberFormatLocal）。这意味着如果您需要将此 NumberFormat 应用于其他单元格，您需要将其分配给本地数字格式：

Selection.NumberFormatLocal = Rng.FormatConditions(n).NumberFormat

如果不这样做，您可能会收到意外的数字格式转义空格，从而导致错误。

功能代码：

    Private Function GetStrippedValue(CF As String) As String
        Dim Temp As String
        If InStr(1, CF, "=", vbTextCompare) Then
           Temp = Mid(CF, 2, Len(CF) - 1)
           If Left(Temp, 1) = "=" Then
               Temp = Mid(Temp, 2)
           End If
        Else
           Temp = CF
        End If
        GetStrippedValue = Temp
    End Function
    
    Private Function ActiveCondition(Rng As Range) As Integer
        Dim Ndx As Long
        Dim FC As FormatCondition
        Dim Temp As Variant
        Dim Temp2 As Variant
        
        If Rng.FormatConditions.Count = 0 Then
            ActiveCondition = 0
        Else
            For Ndx = 1 To Rng.FormatConditions.Count
                Set FC = Rng.FormatConditions(Ndx)
                Select Case FC.Type
                    Case xlCellValue
                    Select Case FC.Operator
                        Case xlBetween
                            Temp = GetStrippedValue(FC.Formula1)
                            Temp2 = GetStrippedValue(FC.Formula2)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) >= CDbl(Temp) And _
                                   CDbl(Rng.Value) <= CDbl(Temp2) Then
                                   ActiveCondition = Ndx
                                   Exit Function
                               End If
                           Else
                              If Rng.Value >= Temp And _
                                 Rng.Value <= Temp2 Then
                                 ActiveCondition = Ndx
                                 Exit Function
                              End If
                           End If
        
                        Case xlGreater
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) > CDbl(Temp) Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            Else
                               If Rng.Value > Temp Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
        
                        Case xlEqual
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) = CDbl(Temp) Then
                                   ActiveCondition = Ndx
                                   Exit Function
                               End If
                            Else
                               If Temp = Rng.Value Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
        
        
                        Case xlGreaterEqual
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) >= CDbl(Temp) Then
                                   ActiveCondition = Ndx
                                   Exit Function
                               End If
                            Else
                               If Rng.Value >= Temp Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
        
                      
                        Case xlLess
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                                If CDbl(Rng.Value) < CDbl(Temp) Then
                                   ActiveCondition = Ndx
                                   Exit Function
                                End If
                            Else
                                If Rng.Value < Temp Then
                                   ActiveCondition = Ndx
                                   Exit Function
                                End If
                            End If
        
                        Case xlLessEqual
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) <= CDbl(Temp) Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            Else
                               If Rng.Value <= Temp Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
        
        
                        Case xlNotEqual
                            Temp = GetStrippedValue(FC.Formula1)
                            If IsNumeric(Temp) Then
                               If CDbl(Rng.Value) <> CDbl(Temp) Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            Else
                               If Temp <> Rng.Value Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
        
                       Case xlNotBetween
                            Temp = GetStrippedValue(FC.Formula1)
                            Temp2 = GetStrippedValue(FC.Formula2)
                            If IsNumeric(Temp) Then
                               If Not (CDbl(Rng.Value) <= CDbl(Temp)) And _
                                  (CDbl(Rng.Value) >= CDbl(Temp2)) Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            Else
                               If Not Rng.Value <= Temp And _
                                  Rng.Value >= Temp2 Then
                                  ActiveCondition = Ndx
                                  Exit Function
                               End If
                            End If
                    
                       Case Else
                            Debug.Print "UNKNOWN OPERATOR"
                   End Select
        
        
                Case xlExpression
                    If Application.Evaluate(FC.Formula1) Then
                       ActiveCondition = Ndx
                       Exit Function
                    End If
        
                Case Else
                    Debug.Print "UNKNOWN TYPE"
               End Select
        
            Next Ndx
        
        End If
        
        ActiveCondition = 0
    
    End Function
    
    Private Function CFNumberFormat(Rng As Range) As String
    
        Dim AC As Integer
        AC = ActiveCondition(Rng)
        If AC = 0 Then
            CFNumberFormat = Rng.NumberFormatLocal
        Else
            CFNumberFormat = Rng.FormatConditions(AC).NumberFormat
        End If
    
    End Function


  [1]: https://i.stack.imgur.com/CJyrD.png

Answer 2

除了一些问题之外，这段代码几乎正是我所需要的。单个单元格上可能有多个活动条件格式。这引发了几个问题：

1. 哪种条件格式优先？ Excel 按数字顺序应用条件格式。如果多个条件格式处于活动状态，则将使用影响数字格式（或任何其他类型的格式）的数字最早的条件格式。
2. 某些条件格式不设置数字格式。不设置数字格式的条件格式将其设置为“”。
3. 条件格式对话框中有一个“如果为真则停止”复选框，告诉 Excel 忽略所有进一步的条件格式规则。

因此，我重写了代码（并添加了对 xlNoBlanksCondition 条件的检查）

Private Function GetStrippedValue(CF As String) As String
Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
        Temp = Mid(CF, 2, Len(CF) - 1)
        If Left(Temp, 1) = "=" Then
            Temp = Mid(Temp, 2)
        End If
    Else
        Temp = CF
    End If
    GetStrippedValue = Temp
End Function
    
Private Function ConditionIsActive(rng As Range, idx As Long) As Boolean
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant

    If idx < 1 Or idx > rng.FormatConditions.count Then
        ConditionIsActive = False
        Exit Function
    End If
    
    Set FC = rng.FormatConditions(idx)
    Select Case FC.Type
        Case xlCellValue
        Select Case FC.Operator
            Case xlBetween
                Temp = GetStrippedValue(FC.Formula1)
                Temp2 = GetStrippedValue(FC.Formula2)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) >= CDbl(Temp) And _
                       CDbl(rng.Value) <= CDbl(Temp2) Then
                       ConditionIsActive = True
                       Exit Function
                   End If
               Else
                  If rng.Value >= Temp And _
                     rng.Value <= Temp2 Then
                     ConditionIsActive = True
                     Exit Function
                  End If
               End If
    
            Case xlGreater
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) > CDbl(Temp) Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                Else
                   If rng.Value > Temp Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
    
            Case xlEqual
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) = CDbl(Temp) Then
                       ConditionIsActive = True
                       Exit Function
                   End If
                Else
                   If Temp = rng.Value Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
    
    
            Case xlGreaterEqual
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) >= CDbl(Temp) Then
                       ConditionIsActive = True
                       Exit Function
                   End If
                Else
                   If rng.Value >= Temp Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
    
          
            Case xlLess
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                    If CDbl(rng.Value) < CDbl(Temp) Then
                       ConditionIsActive = True
                       Exit Function
                    End If
                Else
                    If rng.Value < Temp Then
                       ConditionIsActive = True
                       Exit Function
                    End If
                End If
    
            Case xlLessEqual
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) <= CDbl(Temp) Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                Else
                   If rng.Value <= Temp Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
    
    
            Case xlNotEqual
                Temp = GetStrippedValue(FC.Formula1)
                If IsNumeric(Temp) Then
                   If CDbl(rng.Value) <> CDbl(Temp) Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                Else
                   If Temp <> rng.Value Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
    
           Case xlNotBetween
                Temp = GetStrippedValue(FC.Formula1)
                Temp2 = GetStrippedValue(FC.Formula2)
                If IsNumeric(Temp) Then
                   If Not (CDbl(rng.Value) <= CDbl(Temp)) And _
                      (CDbl(rng.Value) >= CDbl(Temp2)) Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                Else
                   If Not rng.Value <= Temp And _
                      rng.Value >= Temp2 Then
                      ConditionIsActive = True
                      Exit Function
                   End If
                End If
                                    
           Case Else
                Debug.Print "UNKNOWN OPERATOR"
                ConditionIsActive = False
       End Select
    
    Case xlNoBlanksCondition
        If Not IsEmpty(rng) Then
            ConditionIsActive = True
            Exit Function
        End If
    
    
    Case xlExpression
        If Application.Evaluate(FC.Formula1) Then
           ConditionIsActive = True
           Exit Function
        End If
    
    Case Else
        Debug.Print "UNKNOWN TYPE"
        ConditionIsActive = False
    End Select
    
    ConditionIsActive = False
End Function
        
Function CFNumberFormat(rng As Range) As String
Dim idx As Long
Dim FC As FormatCondition
    CFNumberFormat = "General"
    For idx = 1 To rng.FormatConditions.count
        Set FC = rng.FormatConditions(idx)
        If ConditionIsActive(rng, idx) Then
            If FC.numberFormat <> "" Then
                CFNumberFormat = FC.numberFormat
                Exit Function
            End If
            If FC.StopIfTrue Then
                Exit Function
            End If
        End If
    Next idx
End Function