web-dev-qa-db-ja.com

セルにデータ検証が含まれているかどうかを確認する

セルの範囲を通過する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

何か案は？ありがとうございました

vbaexcel-vbaexcel-2010excel
8
user2385809
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
13
Tim Williams

この質問は古いことは知っていますが、「Excel vbaでセルに検証があるかどうかを確認する」という質問が表示されるので、塩を追加することにしました。

Rangeを呼び出すSpecialCellsオブジェクトが単一のセルのみを表す場合、一致するものを見つけるためにシート全体がスキャンされます。非常に大量のデータがある場合、前の回答で提供された方法は少し遅くなる可能性があります。

したがって、単一のセルに検証があるかどうかを確認するためのより効率的な方法は次のとおりです。

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
21
AgentRev

アクティブセルのみをテストする場合は、次のようにします。

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
4
Gary's Student

また、検証Sourceを取得したい場合は、次を使用できます...

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
CRUTER

次にエラーを回避してこれを処理する方法を探しています。これは私が実装する方法です。

Option Explicit
' https://stackoverflow.com/questions/18642930/determine-if-cell-contains-data-validation
' 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
0
Ricardo Diaz

これは私のために働きます

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
0
Sandro Wiggers

約4年後、私も細胞の妥当性検査を探しています。ここでの答えからいくつかを組み合わせて、これは私が思いついたものです：

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
0
Vityata