调用存储在 .xlam 文件中的 UDF 的 Evaluate() 函数并使其作用于另一张纸
Posted
技术标签:
【中文标题】调用存储在 .xlam 文件中的 UDF 的 Evaluate() 函数并使其作用于另一张纸【英文标题】：Calling Evaluate() function of a UDF stored in an .xlam file and making it act on another sheet 【发布时间】：2019-09-16 03:36:27 【问题描述】：我编写了一个 UDF 来检查和计算条件格式的单元格颜色。 更新完整代码如下。
Function CountCellColor(RangeToCount As Range, ColorCell As Range, _
LookupType As String) As Long
'Count the number of cells in range_data that has the same color _
as the criteria cell, including both natural and conditional formatting _
colors. If LookpType is "cell" then it will compare cell background _
colors, if "font" then it will compare font colors.
Dim CFFormula As String
Dim CFCell As Range
Dim CellCounter As Double
Dim CFColor As Long
Dim i, j, k As Integer
CellCounter = 0
If LookupType = "cell" Then
CFColor = ColorCell.Interior.Color
For i = 1 To RangeToCount.Columns.Count 'Loop thru each cell
For j = 1 To RangeToCount.Rows.Count
Set CFCell = RangeToCount.Cells(j, i)
If CFCell.Interior.Color = ColorCell.Interior.Color Then 'If the natural color matches then skip right to count that cell
GoTo CountCellColor
Else
For k = 1 To CFCell.FormatConditions.Count 'Otherwise check each condition format of that cell
If CFCell.FormatConditions(k).Interior.Color = CFColor Then 'if the conditionned color match then check the formula
CFFormula = CFCell.FormatConditions(k).Formula1
CFFormula = Application.ConvertFormula(CFFormula, xlA1, xlR1C1)
CFFormula = Application.ConvertFormula(CFFormula, xlR1C1, xlA1, , ActiveCell.Resize(RangeToCount.Rows.Count, RangeToCount.Columns.Count).Cells(j, 1)) 'shifts to the next cell below in the conditionally formatted column
If Evaluate(CFFormula) = True Then 'if the formula evaluates to true then count that cell. Needs reference to ActiveCell cuz the macro is stored in a different file
CountCellColor:
CellCounter = CellCounter + 1
End If
End If
Next k
End If
Next j
Next i
ElseIf LookupType = "font" Then
CFColor = ColorCell.Font.Color
For i = 1 To RangeToCount.Columns.Count 'Loop thru each cell
For j = 1 To RangeToCount.Rows.Count
Set CFCell = RangeToCount.Cells(j, i)
If CFCell.Font.Color = ColorCell.Font.Color Then 'If the natural color matches then skip right to count that cell
GoTo CountFontColor
Else
For k = 1 To CFCell.FormatConditions.Count 'Otherwise check each condition format of that cell
If CFCell.FormatConditions(k).Font.Color = CFColor Then 'if the conditionned color match then check the formula
CFFormula = CFCell.FormatConditions(k).Formula1
CFFormula = Application.ConvertFormula(CFFormula, xlA1, xlR1C1)
CFFormula = Application.ConvertFormula(CFFormula, xlR1C1, xlA1, , ActiveCell.Resize(RangeToCount.Rows.Count, RangeToCount.Columns.Count).Cells(j, 1)) 'shifts to the next cell below in the conditionally formatted column
If Evaluate(CFFormula) = True Then 'if the formula evaluates to true the count that cell
CountFontColor:
CellCounter = CellCounter + 1
End If
End If
Next k
End If
Next j
Next i
Else
CountCellColor = -1
Exit Function
End If
CountCellColor = CellCounter
End Function
我已经测试过这适用于这些情况：
-
UDF 存储在文件 A 中，UDF 在文件 A 表 1 中调用，目标
范围在文件 A 表 1 中
UDF 存储在文件 A 中，UDF 在文件 A 表 1 中调用，目标范围在文件 A 表 2 中
UDF 存储在加载的 .xlam 文件中，UDF 在文件 A sheet 1 中调用，目标范围也在文件 A sheet 1 中（图 1）
下面这1个案例不起作用 1. UDF存储在加载的.xlam文件中，UDF在文件A sheet 1中被调用，目标范围在文件A sheet 2中
现在，UDF 不返回任何错误，但它只是将 Evaluate(CFFormula) 行评估为 FALSE，并且不增加计数。
我在这样的结构化表格上调用它：
=CountCellColor(LDL1P1[EDL1 Need Trans],$I$5,"cell")
要评估的公式只是 A2="aaa"。所以这真的取决于这个 evaluate() 函数在哪里执行。应该在与 RangeToCount 相同的工作表中完成此操作。
【问题讨论】：
看来Evaluate(CFFormula)工作不正常（可能是长度？）检查docs.microsoft.com/en-us/office/vba/api/…
Evaluate 公式适用于前 3 个案例。在最后一种情况下，它可能指的是错误的工作簿。所以我需要引用找到 RangeToCount 的工作表来调用 Evaluate()。
没有更多信息，不可能知道它是如何工作的……给我们看一个“CFFormula”示例
我怀疑这不是正确的 UDF。似乎调用全局变量（标准调用Option Explicit！），甚至可能尝试修改单元格（ConvertFormula：转换公式中的单元格引用）。因此，无论代码在技术上多么正确，它总是会返回错误。
我更新了 OP 人员。请再读一遍。谢谢！ @AJD 这个 UDF 在我提到的 3 种情况下都能正常工作。
【参考方案1】：
我认为 Evaluate() 将始终在活动表上运行。因此，如果您需要它在另一张纸上运行，则需要指定。
RangeToCount.Parent.Evaluate(CFFormula)
【讨论】：
【参考方案2】：这里有几个问题加剧了您的问题
Evaluate（它自己）是 Application.Evaluate 的快捷方式，它在 Active Sheet 的上下文中调用。使用工作表舀版。
您使用ConvertFormula 抵消CF 公式的代码并非在所有情况下都有效。它也与活动工作表相关联，如果条件格式范围未与包含CountCellColor 公式的单元格对齐，则它根本不起作用。
虽然不是您的问题，但像这样使用 GoTo 确实是一种不好的做法
自然色细胞计数，只有在颜色未被 CF'g 改变的情况下才应计数
RangeToCount 可能包含多个不同的 CF 区域，因此需要考虑到这一点
此代码仅适用于表达式类型 CF'g，因此对此进行测试
其他小的改进机会（见下面的代码）
你的代码，重构
Function CountCellColor( _
RangeToCount As Range, _
ColorCell As Range, _
LookupType As String) As Long
'Count the number of cells in range_data that has the same color _
as the criteria cell, including both natural and conditional formatting _
colors. If LookpType is "cell" then it will compare cell background _
colors, if "font" then it will compare font colors.
'Only counts Natural colored cells, if they are not colored by CF'g
Dim CFFormula As String
Dim CFCell As Range
Dim CellCounter As Long '<~~~ you are counting, so use an int type
Dim CFColor As Long
Dim Rng As Range, cl As Range
Dim CountedCell As Boolean
Dim FC As FormatCondition
CellCounter = 0
If StrComp(LookupType, "cell", vbTextCompare) = 0 Then '<~~~ case insensitive
CFColor = ColorCell.Interior.Color
For Each CFCell In RangeToCount.Cells '<~~~ Loop thru each cell
CountedCell = False
For Each FC In CFCell.FormatConditions 'check each conditional format of that cell
If FC.Type = xlExpression Then
'shifts to the next cell below in the conditionally formatted column.
'Must be in the context of the passed range and its worksheet
Set Rng = FC.AppliesTo.Cells(1, 1)
CFFormula = FC.Formula1
CFFormula = Application.ConvertFormula(CFFormula, xlA1, xlR1C1, False, Rng)
CFFormula = Application.ConvertFormula(CFFormula, xlR1C1, xlA1, False, CFCell)
If RangeToCount.Worksheet.Evaluate(CFFormula) = True Then
'if the formula evaluates to true then consider that cell.
CountedCell = True
If FC.Interior.Color = CFColor Then
'if the conditionned color match then count
CellCounter = CellCounter + 1
End If
End If
End If
Next
' Only count base color cells that are not colored by CF
If Not CountedCell Then
If CFCell.Interior.Color = CFColor Then
CellCounter = CellCounter + 1
End If
End If
Next
ElseIf StrComp(LookupType, "font", vbTextCompare) = 0 Then
' similar
Else
CountCellColor = -1
End If
CountCellColor = CellCounter
End Function
也就是说，有一个更简单的方法 - 如果您有支持 DisplayFormat 的足够晚版本的 Excel（Excel 2010 或更高版本）
Function CountCellColor2( _
RangeToCount As Range, _
ColorCell As Range, _
LookupType As String) As Long
Dim cl As Range
Dim MatchColor As Long
Dim CellCounter As Long
If StrComp(LookupType, "cell", vbTextCompare) = 0 Then
MatchColor = ColorCell.Interior.Color
For Each cl In RangeToCount.Cells
If cl.DisplayFormat.Interior.Color = MatchColor Then
CellCounter = CellCounter + 1
End If
Next
ElseIf StrComp(LookupType, "font", vbTextCompare) = 0 Then
MatchColor = ColorCell.Font.Color
For Each cl In RangeToCount.Cells
If cl.DisplayFormat.Font.Color = MatchColor Then
CellCounter = CellCounter + 1
End If
Next
End If
CountCellColor2 = CellCounter
End Function
【讨论】：
以上是关于调用存储在 .xlam 文件中的 UDF 的 Evaluate() 函数并使其作用于另一张纸的主要内容，如果未能解决你的问题，请参考以下文章