简体   繁体   中英

VBA - get the actual cell's NumberFormat after applying conditional formatting

Example: We have simple cell with General formatting.

图。1

Let's add conditional formatting that will change cell's NumberFormat to "# ##0.00" . Now it looks like this

图2

The question is how do I get the current NumberFormat for the cell from VBA code? Given that I need the format that is actually displayed.

When I try .NumberFormat or .DisplayFormat.NumberFormat - same result = "General". Is there a way to get the correct Numberformat - "# ##0.00" ?

图3

PS The reason why I need it - I'm trying to make a VBA macro that would save cells current formatting but remove all conditional formatting calculations.

As @Ron Rosefeld and @FaneDuru pointed out - guess the only solution is to loop through all the format conditions and get the one that worked. As expected it's quite tricky.

Fortunately I've found a function to determine which CF is currently active for the given cell (if any) - function ActiveCondition from http://www.cpearson.com/excel/cfcolors.htm . I've modified it and made CFNumberFormat function which does what I wanted. The code is below.

Example: https://i.stack.imgur.com/CJyrD.png

One more valid notion - turned out Rng.FormatConditions(n).NumberFormat always returns Local number format (.NumberFormatLocal). Meaning if you need to apply this NumberFormat to some other cell you'll need to assign it to local number format:

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

If you don't then you might get unexpected escaped spaces in number format that will result in errors.

Function code:

    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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM