确定单元格是否包含数据验证。

13

我正在编写一个VBA代码,通过检查单元格的范围来确定每个单元格是否具有数据验证(下拉菜单),如果没有,则从另一个工作表上的列表中分配一个。

我目前遇到了检查当前单元格是否已经具有数据验证的问题。我得到了错误1004“未找到任何单元格”。

Sub datavalidation()

    Dim nlp As Range
    Dim lrds As Long
    Dim wp As Double
    Dim ddrange As Range

    Sheets("DataSheet").Select

        lrds = ActiveSheet.Range("A1").Offset(ActiveSheet.rows.Count - 1, 0).End(xlUp).Row

        Set nlp = Range("I3:I" & lrds)

        For Each cell In nlp

    'error on following line

            If cell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
                wp = cell.Offset(0, -8).Value

                Set ddrange = ddrangefunc(wp)

            End If

        Next

End Sub

有什么想法吗? 谢谢

8个回答

34

我知道这个问题已经很老了,但是因为当我在谷歌搜索"excel vba check if cell has validation"时会出现这个问题,所以我认为我会添加我的建议。

如果你在调用SpecialCells方法时使用的Range对象只包含一个单元格,整个工作表将被扫描以查找匹配项。如果你有大量数据,那么先前答案中提供的方法可能会变得有点慢。

因此,这里是一种更有效的方法来检查单个单元格是否具有验证:

Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null

    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0

    HasValidation = Not IsNull(t)
End Function

2
请注意,您可以将多个单元格范围传递给“cell”。如果您这样做,并且该范围的一部分包含数据验证,则它会错误地报告“False”。 - IvenBach

16
Dim cell As Range, v As Long

For Each cell In Selection.Cells
    v = 0
    On Error Resume Next
    v = cell.SpecialCells(xlCellTypeSameValidation).Count
    On Error GoTo 0

    If v = 0 Then
        Debug.Print "No validation"
    Else
        Debug.Print "Has validation"
    End If
Next

Tim的答案对你来说应该没问题,但你可能想将错误处理程序限制为仅为该特定错误号提供该响应。 - dennythecoder

6

如果你只想测试活动单元格,则:

Sub dural()
    Dim r As Range
    On Error GoTo noval
    Set r = Cells.SpecialCells(xlCellTypeAllValidation)
    If Intersect(r, ActiveCell) Is Nothing Then GoTo noval
    MsgBox "Active cell has validation."
    Exit Sub
noval:
    MsgBox "Active cell has no validation."
    On Error GoTo 0
End Sub

如果您真正有兴趣检查某个单元格是否具有验证,则这是最有效的方法。如果您要检查工作表中的所有单元格,则可以修改此方法以获取范围r一次,然后循环遍历每个单元格和范围r相交的位置,将验证添加到没有它的单元格中。 - GlennFromIowa

2

寻找一种避免使用错误恢复的方法。这是我实施的方式:

Option Explicit
' https://dev59.com/xmMl5IYBdhLWcg3wKkLW
' Use this if you want to omit doing something to the cell added: http://dailydoseofexcel.com/archives/2007/08/17/two-new-range-functions-union-and-subtract/
Sub ValidationCells()

    Dim theSheet As Worksheet
    Dim lastCell As Range
    Dim validationRange As Range
    Dim validationCell As Range
    
    Application.EnableEvents = False ' optional
    
    Set theSheet = ThisWorkbook.Worksheets(1)
    
    theSheet.Unprotect ' optional
    
    ' Add a cell with a value and some validation to bypass specialcells error
    Set lastCell = theSheet.Cells(1, theSheet.Cells.Columns.Count)
    With lastCell
        .Value2 = 1
        .Validation.Add xlValidateWholeNumber, xlValidAlertInformation, xlEqual, "1"
    End With
    
    ' If usedrange is greater than 1 (as we added a single cell previously)
    If theSheet.UsedRange.Rows.Count > 1 Or theSheet.UsedRange.Columns.Count > 1 Then
    
        Set validationRange = theSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
        
        MsgBox validationRange.Address
        
        For Each validationCell In validationRange
            If validationCell.Address <> lastCell.Address Then
                MsgBox validationCell.Address
            End If
        Next validationCell
        
    End If
    
    lastCell.Clear
    
    Set validationRange = Nothing
    Set lastCell = Nothing
    
    theSheet.Protect ' optional
    
    Application.EnableEvents = True ' optional
    

End Sub

1
大约四年后,我也在寻找关于单元格验证的内容。结合这里的一些回答,我得到了以下内容:
Option Explicit

Public Sub ShowValidationInfo()

    Dim rngCell             As Range
    Dim lngValidation       As Long

    For Each rngCell In ActiveSheet.UsedRange

        lngValidation = 0

        On Error Resume Next
        lngValidation = rngCell.SpecialCells(xlCellTypeSameValidation).Count
        On Error GoTo 0

        If lngValidation <> 0 Then
            Debug.Print rngCell.Address
            Debug.Print rngCell.Validation.Formula1
            Debug.Print rngCell.Validation.InCellDropdown
        End If
    Next

End Sub

1
此外,如果您想获取验证源代码,您可以使用以下方法...
Dim cell as Range
Dim rng as Range
Set rng = Range("A1:A10") 'enter your range

On Error Resume Next 'will skip over the cells with no validation

For Each cell In rng
    msgbox cell.Validation.Formula1
Next cell

1
Function isValidated(ByVal Cell as Range) as Boolean
    On Error Resume Next
    isValidated = Not isEmpty(Cell.Validation.Type)
End Function

0

这对我有效

Sub test()
    On Error Resume Next
        If ActiveCell.SpecialCells(xlCellTypeSameValidation).Cells.Count < 1 Then
            MsgBox "validation"
        Else
            MsgBox "no Validation"
        End If
    On Error GoTo 0
End Sub

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接