檢查Excel 2003中的數據驗證

VBA的以下位將強調所有細胞與數據驗證錯誤表：檢查Excel 2003中的數據驗證

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」循環或以某種方式加速的方法嗎？

我本來以爲下面將相當於設定「dvError」的值：

dvError = Not rngDV.Validation.Value

但由於某些原因，即使有數據驗證錯誤rngDV.Validation.Value是真實的。

來源

2010-09-27 mpeac

想你的代碼，它的工作相當快含驗證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時除外 - 當然）

作爲一個通用提示：試圖找出究竟你的代碼是緩慢的，讓我們它從它即

來源

2010-09-28 10:09:44 MikeD

感謝MikeD，我有相當多的數據驗證單元（猜測，成千上萬？），延遲相當明顯。我已經介紹了代碼，for循環確實是罪魁禍首。我認爲衆所周知，任何以逐個單元爲基礎運行的代碼比使用批量操作要慢得多（參見，例如http://www.ozgrid.com/VBA/VBALoops.htm）。 – mpeac 2010-09-29 12:46:11

我有一個稍微不同的要求，我想限制用戶輸入的值到有效的日期範圍或文本「儘快」我使用以下解決;

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

來源

2012-01-04 05:22:16

檢查Excel 2003中的數據驗證

回答

相關問題