Проверка правильности данных Excel 2003 - PullRequest
Новая
       7

Проверка правильности данных Excel 2003

1 голос
/ 27 сентября 2010

Следующий бит 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

Однако цикл «Для каждого» выполняется очень медленно на листах с большой проверкой данных.

Кто-нибудь знает, как избежать цикла «Для каждого» или как-то ускорить его?

Я бы подумал, что следующее будет эквивалентно установке значения 'dvError': 

dvError = Not rngDV.Validation.Value

Но по какой-то причине rngDV.Validation.Value имеет значение true, даже если имеются ошибки проверки данных.

Ответы [ 2 ]

2 голосов
/ 04 января 2012

У меня было немного другое требование, когда я хотел ограничить введенные пользователем значения допустимым диапазоном дат или текстом «КАК МОЖНО СКОРЕЕ», который я решил с помощью следующего: 

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
1 голос
/ 28 сентября 2010

Попробовал ваш код, и он довольно быстро работает с 4536 ячейками, содержащими проверки - так как вы по праву нарушаете свой FOR при первом появлении неподтвержденной ячейки

Я пытался измерить время в разных точках вашего кода, выполнив: 

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)

Как общий совет ... попытайтесь выяснить, где именно ваш код медленный, и давайте возьмем его оттуда.

...