数据验证UDF与@隐式交集运算符问题排查求助

问题背景 #

原代码通过动态字符串创建数据验证（DV），但存在逗号分隔值超出255字符限制的问题。因目标数据已分组排序，改为使用动态范围实现后，出现两个核心问题：

• 工作表Change事件调用UDF时，Excel自动添加的*@运算符*导致返回#VALUE!错误，手动移除@后DV可正常工作。
• 单步调试发现UDF会在添加数据验证的代码行中途停止，随后在ElseIf QTY > 1 Then处重启，第二次运行才能完成执行；即使Change事件中已禁用事件，UDF仍会执行两次。

相关代码 #

UDF函数代码 #

Option Explicit

Function DDDDL(Variable)

Dim Find As String, List As String
Dim QTY As Integer, Row As Integer
Dim lastrow As Long
Dim RNG As Range, Cell As Range

lastrow = Sheets("Tags").Range("B" & Rows.Count).End(xlUp).Row
QTY = Application.WorksheetFunction.XLookup(Variable, Sheets("Tags").Range("B3:B" & lastrow), Sheets("Tags").Range("A3:A" & lastrow), 0, 0, 1)

    If QTY = 0 Then
        Application.ThisCell.Validation.Delete
        DDDDL = "Tag not found in DB"

    ElseIf QTY = 1 Then
        Application.ThisCell.Validation.Delete
        DDDDL = Application.WorksheetFunction.XLookup(Variable, Sheets("Tags").Range("B3:B" & lastrow), _
        Sheets("Tags").Range("C3:C" & lastrow), "TAG Description NOT found", 0, 1)

    ElseIf QTY > 1 Then
        DDDDL = "Pick From List"
                Row = Worksheets("Tags").Range("B3:B" & lastrow).Find(Variable, , xlValues, xlWhole).Row
            Set RNG = Range("C" & Row & ":C" & (Row + QTY - 1))
                With Application.ThisCell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, Formula1:="='Tags'!" & RNG.Address
                        .InCellDropdown = True
                        .ErrorTitle = "TAG Description NOT found"
                        .ErrorMessage = "This TAG Description was not found in the Database." & vbCrLf & "Click YES to continue, but remember to register the TAG."
                End With
    End If
End Function

工作表Change事件代码 #

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastrow As Integer
Dim rng1 As Range, rng2 As Range, rng3 As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

    Set rng1 = Range("K22:K" & lastrow)
    Set rng2 = Range("S22:S" & lastrow)
    Set rng3 = Range("C19:C" & lastrow)
        
        If Application.Intersect(Target, rng1) Is Nothing Then
            ElseIf Application.Intersect(Target, rng1).Address = Target.Address Then
                If Target = "" Then
                    Cells(Target.Row, 12).Validation.Delete
                    Cells(Target.Row, 12) = ""
                ElseIf Target <> "" Then
                    Cells(Target.Row, 12).FormulaR1C1 = "=DDDDL(RC[-1])"
                End If
        End If

        If Application.Intersect(Target, rng2) Is Nothing Then
            ElseIf Application.Intersect(Target, rng2).Address = Target.Address Then
                If Target = "" Then
                    Cells(Target.Row, 20).Validation.Delete
                    Cells(Target.Row, 20) = ""
                ElseIf Target <> "" Then
                    Cells(Target.Row, 20).FormulaR1C1 = "=DDDDL(RC[-1])"
                End If
        End If
        
        If Application.Intersect(Target, rng3) Is Nothing Then
            ElseIf Application.Intersect(Target, rng3).Address = Target.Address Then
                If Target = "" Then
                ElseIf Target <> "" Then
                    UpdateTheRibbon
                End If
        End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

问题分析与解决建议 #

1. #VALUE!错误（@运算符问题） #

• 原因：Excel 365及后续版本中，UDF作为数组公式调用时会自动添加*@运算符*，强制返回单个值，但数据验证的范围引用会被@破坏，导致公式解析失败。
• 解决方法：
  • 优先将数据验证的创建逻辑从UDF移至Worksheet_Change事件中，避免UDF直接操作工作表对象。
  • 若坚持使用UDF，设置Formula1时将范围地址转换为绝对引用，规避@的影响：

    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, Formula1:=Application.ConvertFormula("='Tags'!" & RNG.Address, xlA1, xlA1, xlAbsolute)
    

2. UDF重复执行/中途重启问题 #

• 原因：
  • UDF中修改单元格验证规则会触发工作表计算事件，即使Change事件禁用了事件，计算事件仍可能触发UDF重新执行。
  • Application.ThisCell在UDF执行过程中可能因上下文变化导致代码中断重启。
• 解决方法：
  • 将所有数据验证逻辑迁移至Worksheet_Change事件，UDF仅负责返回提示文本，示例调整如下：

    ' 在Worksheet_Change事件中替换原UDF调用逻辑
    Dim qtyVal As Integer
    Dim tagLastRow As Long
    Dim targetCell As Range
    Dim rngList As Range
    
    tagLastRow = Sheets("Tags").Range("B" & Rows.Count).End(xlUp).Row
    Set targetCell = Cells(Target.Row, Target.Column + 1)
    
    qtyVal = Application.WorksheetFunction.XLookup(Target.Value, Sheets("Tags").Range("B3:B" & tagLastRow), Sheets("Tags").Range("A3:A" & tagLastRow), 0, 0, 1)
    
    Select Case qtyVal
        Case 0
            targetCell.Validation.Delete
            targetCell.Value = "Tag not found in DB"
        Case 1
            targetCell.Validation.Delete
            targetCell.Value = Application.WorksheetFunction.XLookup(Target.Value, Sheets("Tags").Range("B3:B" & tagLastRow), Sheets("Tags").Range("C3:C" & tagLastRow), "TAG Description NOT found", 0, 1)
        Case Is > 1
            Dim findRow As Integer
            findRow = Sheets("Tags").Range("B3:B" & tagLastRow).Find(Target.Value, , xlValues, xlWhole).Row
            Set rngList = Sheets("Tags").Range("C" & findRow & ":C" & (findRow + qtyVal - 1))
            targetCell.Validation.Delete
            With targetCell.Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, Formula1:="='Tags'!" & rngList.Address
                .InCellDropdown = True
                .ErrorTitle = "TAG Description NOT found"
                .ErrorMessage = "This TAG Description was not found in the Database." & vbCrLf & "Click YES to continue, but remember to register the TAG."
            End With
            targetCell.Value = "Pick From List"
    End Select
    

  • 临时方案：在UDF执行前设置Application.Calculation = xlCalculationManual，执行后恢复自动计算，但需注意可能影响其他公式的实时计算。

内容的提问来源于stack exchange，提问作者Martin