代码之家 › 专栏 › 技术社区 › mpeac

检查Excel 2003数据验证

excel vba validation excel-2003 excel-vba

mpeac · 技术社区 · 16 年前

VBA的以下位将突出显示工作表中存在数据验证错误的任何单元格:

Sub CheckValidation(sht As Worksheet)
Dim cell As Range
Dim rngDV As Range
Dim dvError As Boolean

On Error Resume Next
Set rngDV = sht.UsedRange.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0

If rngDV Is Nothing Then
    sht.ClearCircles
Else
    dvError = False
    For Each cell In rngDV
        If Not cell.Validation.Value Then
            dvError = True
            Exit For
        End If
    Next

    If dvError Then
        sht.CircleInvalid
        sht.Activate
    Else
        sht.ClearCircles
    End If
End If
End Sub

然而,“For Each”循环在有大量数据验证的工作表中运行得非常慢。

有没有人知道如何避免“For Each”循环,或者以某种方式加速循环?

dvError = Not rngDV.Validation.Value

2 回复 | 直到 8 年前

MikeD 16 年前

尝试了你的代码,它在4536个包含验证的单元格中运行得非常快,因为你在第一次出现未验证的单元格时就正确地打破了你的规则

我试图通过以下方式测量代码中各个点的时间:

Dim Tick As Variant
Tick = Now()
' ... code
Debug.Print "ValCount", rngDV.Cells.Count ' just to see how many cells are in that range
' ... code
Debug.Print "Pt1",  (Now() - Tick) * 86400000 'display milliseconds
' ... code
Debug.Print "Pt2",  (Now() - Tick) * 86400000 'display milliseconds
' ... code
Debug.Print "Pt3",  (Now() - Tick) * 86400000 'display milliseconds
' etc.

并且得到了一个不可测量的延迟(当然除了用F8步进调试程序时)

Devin Burke Robert Isaev 14 年前

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sErr        As String
    Dim sProc       As String

    On Error GoTo ErrHandler

    Application.EnableEvents = False

    Select Case Target.Column
    Case 11
        sProc = "Validate Date"

        'The value must be a date between "1 Nov 2011" and "30 Jun 2012" or "ASAP"...
        If IsDate(Target.Value) Then
            If Target.Value < CDate("2011-11-01") _
            Or Target.Value > CDate("2012-06-30") Then
                Err.Raise vbObjectError + 1
            End If
        ElseIf LCase(Target.Value) = "asap" Then
            Target.Value = "ASAP"
        ElseIf Len(Trim(Target.Value)) = 0 Then
            Target.Value = vbNullString
        Else
            Err.Raise vbObjectError + 1
        End If
    End Select

ErrHandler:
    Select Case Err.Number
    Case 0
        'Nothing to do...
    Case vbObjectError + 1
        sErr = "The Date must be between ""1 Nov 2011"" and ""30 Jun 2012"" or equal ""ASAP""."
    Case Else
        sErr = Err.Description
    End Select

    If Len(Trim(sErr)) > 0 Then
        Target.Select
        MsgBox sErr, vbInformation + vbOKOnly, sProc
        Target.Value = vbNullString
    End If

    Application.EnableEvents = True
End Sub

推荐文章

Dónal · Spring Boot应用程序中的伪造证明文件类型验证

1 年前

David · 何时实际应用字符编码?

1 年前

Felix Cartwright · 为什么在我的JSON模式中没有遵守必填字段?

2 年前

Todd · 创建Powershell脚本,检查.csv文件中每行是否有两个字符串和一个整数

2 年前

Qiuzman · 如何确保v-combobox中的所有项目都遵循规则

2 年前