VBA -在应用条件格式后获取实际单元格的NumberFormat
VBA -在应用条件格式后获取实际单元格的NumberFormat
提问于 2020-10-17 15:02:15
例如:我们有一个带有常规格式的简单单元格。
让我们添加将单元格的NumberFormat更改为"# ##0.00"的条件格式。现在它看起来像这样
问题是如何从VBA代码中获取单元格的当前NumberFormat？假设我需要实际显示的格式。
当我尝试.NumberFormat或.DisplayFormat.NumberFormat时-相同的结果=“常规”。有没有办法获得正确的数字格式- "# ##0.00"
PS我需要它的原因-我正在尝试创建一个VBA宏，它将保存单元格的当前格式，但删除所有条件格式计算。
回答 1
Stack Overflow用户
回答已采纳
发布于 2020-10-18 09:41:45
正如@Ron Rosefeld和@FaneDuru指出的那样--我猜唯一的解决方案就是遍历所有的格式条件，并得到一个有效的。不出所料，这是相当棘手的。
幸运的是，我找到了一个函数来确定对于给定的单元当前哪个CF是活动的(如果有的话)-来自http://www.cpearson.com/excel/cfcolors.htm的函数ActiveCondition。我已经修改了它，并制作了CFNumberFormat函数，它可以做我想做的事情。代码如下。
示例：https://i.stack.imgur.com/CJyrD.png
另一个有效的概念是，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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/64403866
复制相关文章
相似问题
腾讯云开发者
