Excel VBA创建动态数据验证公式如何传入动态单元格地址

现有固定引用A1的IP校验公式可正常运行，要实现动态引用传入的目标单元格，可参考以下两种落地方法，先附原有参考代码：

Dim cellAddress as Variant 
cellAddress = Target.value 'Target is a Range

' 原固定引用A1的校验公式
=AND(COUNT(FILTERXML("<t><s>"&SUBSTITUTE(A1,".","</s><s>")&"</s></t>","//s[.*1>-1][.*1<256]"))=4,LEN(A1)-LEN(SUBSTITUTE(A1,".",""))=3)

注意：当前代码中cellAddress = Target.Value取到的是单元格的内容，不是单元格引用地址，如果要做公式引用，需要取Target.Address属性获取单元格的A1样式地址。

方案1：纯VBA逻辑校验（推荐，性能更高） #

不需要依赖工作表公式计算，直接在VBA中完成IP格式校验，逻辑可控，也不会出现FILTERXML的XML转义兼容问题：

Function IsValidIP(targetRng As Range) As Boolean
    Dim ipText As String, ipParts As Variant
    Dim partIndex As Long, partValue As Long
    
    ipText = Trim(targetRng.Value)
    ' 先校验点分隔符数量必须为3
    If Len(ipText) - Len(Replace(ipText, ".", "")) <> 3 Then
        IsValidIP = False
        Exit Function
    End If
    
    ipParts = Split(ipText, ".")
    ' 校验分段数必须为4
    If UBound(ipParts) - LBound(ipParts) + 1 <> 4 Then
        IsValidIP = False
        Exit Function
    End If
    
    ' 逐段校验数值范围0-255
    For partIndex = LBound(ipParts) To UBound(ipParts)
        If Not IsNumeric(ipParts(partIndex)) Then
            IsValidIP = False
            Exit Function
        End If
        partValue = CLng(ipParts(partIndex))
        If partValue < 0 Or partValue > 255 Then
            IsValidIP = False
            Exit Function
        End If
        ' 如需禁止01、001这类带前导零的格式，保留以下判断，否则可删除
        If CStr(partValue) <> ipParts(partIndex) Then
            IsValidIP = False
            Exit Function
        End If
    Next
    
    IsValidIP = True
End Function

调用方式：直接传入目标单元格对象即可，比如If IsValidIP(Target) Then 执行校验通过后的逻辑

方案2：保留原有FILTERXML公式逻辑，动态拼接引用 #

如果需要完全沿用原有公式的计算逻辑，不管是要在VBA中直接获取计算结果，还是要把公式动态写入单元格，只要将公式中固定的A1替换为动态获取的目标单元格地址即可：

Sub RunDynamicIPCheck()
    Dim targetCell As Range
    Dim cellRef As String, dynamicFormula As String
    Dim checkPass As Boolean
    
    ' 替换为你实际的目标单元格对象
    Set targetCell = Target
    ' 获取A1样式的单元格地址，参数为False代表相对引用，需要绝对引用改为True即可
    cellRef = targetCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    
    ' 拼接动态公式，VBA中字符串内的双引号需要写两个做转义
    dynamicFormula = "AND(COUNT(FILTERXML(""<t><s>""&SUBSTITUTE(" & cellRef & ",""."",""</s><s>"")&""</s></t>"",""//s[.*1>-1][.*1<256]""))=4,LEN(" & cellRef & ")-LEN(SUBSTITUTE(" & cellRef & ",""."",""""))=3)"
    
    ' 方式1：直接在VBA中计算拿到校验结果
    checkPass = Application.Evaluate(dynamicFormula)
    
    ' 方式2：如果需要把公式写入单元格（比如写到目标单元格右侧相邻列），取消注释下面一行即可
    ' targetCell.Offset(0, 1).Formula = "=" & dynamicFormula
End Sub

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