Excel 应用于任何突出显示的列的数据验证，该列允许使用特定文本的值

我需要密码来

1.）在标题中查找字符串（在本例中，假设为“Email”）

2.）突出显示包含该标题名称的整个列

3.）应用只允许带“@”的值的数据验证

我有ff代码。它突出显示列并运行验证，但我得到的输出不正确。即使在输入带有“@”的文本时，它仍然会给我一个警告

子FindAddressColumn（）
Dim xRg As范围
Dim xRgUni As范围
Dim xFirstAddress作为字符串
Dim xStr作为字符串
出错时继续下一步
xStr=“电子邮件”
设置xRg=Range（“A1:BZ1”）。查找（xStr，xlValues，xlWhole，True）
如果不是，那么xRg什么都不是
xFirstAddress=xRg.Address
做
设置xRg=范围（“A1:BZ1”）。FindNext（xRg）
如果xRgUni什么都不是，那么
设置xRgUni=xRg
其他的
设置xRgUni=Application.Union（xRgUni，xRg）
如果结束
循环While（非xRg即无）和（xRg.Address xFirstAddress）
如果结束
xRgUni.entireclumn.Select
选择。验证
.Add类型：=xlValidateCustom，警报样式：=xlValidAlertWarning，运算符_
：=xlBetween，公式1:=“=ISNUMBER（查找（“@”））
.IgnoreBlank=True
.InCellDropdown=True
.ErrorTitle=“无效电子邮件”
.ShowInput=True
.ror=真
以
范围（“A1”）。选择
端接头

---

我在想，这是否与验证公式有关。提前谢谢

我认为您不能合并所有列并应用基于公式的验证：更容易单独处理每个列

此外，find/findnext逻辑更好地分解为可重用函数

子设置EmailValidation（）
将所有HDR调暗为集合，c调暗为范围，rng调暗为范围
设置allHdrs=FindAll（范围（“A1:BZ1”），“电子邮件”）
对于所有HDR中的每个c
设置rng=c.Offset（1，0）。调整大小（Rows.Count-c.Row）
使用rng.Validation
.删除
.Add类型：=xlValidateCustom，AlertStyle:=xlValidAlertWarning，运算符：=xlBetween_
公式1:=“=ISNUMBER（查找（“@“）”和rng.Cells（1）.Address（False，False）和“）”
.IgnoreBlank=True
.InCellDropdown=True
.ErrorTitle=“无效电子邮件”
.ShowInput=True
.ror=真
以
下一个c
端接头
'查找范围内具有匹配值的所有单元格
公共函数FindAll（rng作为范围，val作为字符串）作为集合
尺寸rv为新系列，f为范围
Dim addr作为字符串
设置f=rng.Find（what:=val，after:=rng.Cells（rng.Cells.Count）_
LookIn:=xlValues，LookAt:=xlother，SearchOrder:=xlByRows_
SearchDirection:=xlNext，MatchCase:=False）
如果不是f，则addr=f.Address（）
直到f什么都不是
rv.添加f
设置f=rng.FindNext（后面：=f）
如果f.Address（）=addr，则退出Do
环
设置FindAll=rv
端函数

FIND（）接受两个参数，而不是一个……但是我不确定您是否能够可靠地将基于公式的验证添加到使用Union（）形成的多区域范围中

Sub FindAddressColumn()
Dim xRg As Range
Dim xRgUni As Range
Dim xFirstAddress As String
Dim xStr As String

On Error Resume Next

xStr = "Email"
Set xRg = Range("A1:BZ1").Find(xStr, , xlValues, xlWhole, , , True)
If Not xRg Is Nothing Then
    xFirstAddress = xRg.Address
    Do
        Set xRg = Range("A1:BZ1").FindNext(xRg)
        If xRgUni Is Nothing Then
            Set xRgUni = xRg
        Else
            Set xRgUni = Application.Union(xRgUni, xRg)
        End If
    Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
End If

xRgUni.EntireColumn.Select

 With Selection.Validation
    .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertWarning, Operator _
    :=xlBetween, Formula1:="=ISNUMBER(FIND(""@"",))"
    .IgnoreBlank = True
    .InCellDropdown = True
    .ErrorTitle = "Invalid Email"
    .ShowInput = True
    .ShowError = True
End With
Range("A1").Select
End Sub