Excel - 复杂验证的策略

Question

我似乎陷入两难境地.我有一个EXCEL 2003模板,用户应使用该模板填写表格信息.我对各种单元格进行了验证,并且每行都会在change和choices_change事件后进行相当复杂的VBA验证.工作表受到保护,不允许格式化活动,插入和删除行和列等.

只要用户逐行填写表格,所有工作都很好.如果我想允许用户将数据复制/粘贴到该表中(在这种情况下这是合法的用户需求),情况会变得更糟,因为单元验证将禁止粘贴操作.

因此,我尝试允许用户关闭保护和剪切/粘贴,VBA标记工作表以指示它包含未经验证的条目.我创建了一个"批处理验证",可以一次验证所有非空行.仍然复制/粘贴不能很好地工作(必须直接从源表跳转到目标,不能从文本文件粘贴等)

从插入行的角度来看,单元格验证也不是很好,因为根据您插入行的位置,单元格验证可能会完全丢失.如果我将单元格验证复制到第65k行,则空白页的大小超过2M - 这是另一个最不需要的副作用.

所以我认为解决问题的一种方法是完全忘记单元格验证并仅使用VBA.然后,我会牺牲用户在某些列中提供下拉列表的舒适度 - 其中一些列也会根据其他列中的条目进行更改.

有没有人之前处于相同的情况,可以给我一些(通用的)战术建议(编码VBA不是问题)？

亲切的问候MikeD

Answer 1

这是我想出的（全部Excel 2003）

我的工作簿中需要复杂验证的所有工作表都以表格形式组织，并带有几个包含工作表标题和列标题的标题行。最后一行右侧的所有列都被隐藏，并且低于实际限制（在我的例子中为 200 行）的所有行也被隐藏。我已经设置了以下模块：

• GlobalDefs ... 枚举
• CommonFunctions ...所有工作表使用的函数
• Sheet_X_Functions ...单个工作表特有的函数
• 以及 Sheet_X 本身的事件触发器

枚举纯粹是为了避免硬编码；如果我想添加或删除列，我主要编辑枚举，而在实际代码中，我对每列使用符号名称。这听起来可能有点过于复杂，但当用户第三次来并要求我修改表格布局时，我学会了喜欢它。

' module GlobalDefs
Public Enum T_Sheet_X
    NofHRows = 3    ' number of header rows
    NofCols = 36    ' number of columns
    MaxData = 203   ' last row validated
    GroupNo = 1     ' symbolic name of 1st column
    CtyCode = 2     ' ...
    Country = 3
    MRegion = 4
    PRegion = 5
    City = 6
    SiteType = 7
    ' etc
End Enum

首先我描述事件触发的代码。

该线程中的建议是捕获 PASTE 活动。Excel-2003 中的事件触发器并不真正支持，但最终不是什么大奇迹。捕获/取消捕获 PASTE 发生在 Sheet_X 中的激活/停用事件上。在停用时，我还会检查保护状态。如果未受保护，我会要求用户同意批量验证并重新保护。单行验证和批量验证例程是下面进一步描述的模块 Sheet_X_Functions 中的代码对象。

' object in Sheet_X
Private Sub Worksheet_Activate()
' suspend PASTE
    Application.CommandBars("Edit").Controls("Paste").OnAction = "TrappedPaste" ' main menu
    Application.CommandBars("Edit").Controls("Paste Special...").OnAction = "TrappedPaste" ' main menu
    Application.CommandBars("Cell").Controls("Paste").OnAction = "TrappedPaste" ' context menu
    Application.CommandBars("Cell").Controls("Paste Special...").OnAction = "TrappedPaste" ' context menu
    Application.OnKey "^v", "TrappedPaste" ' key shortcut
End Sub

' object in Sheet_X
Private Sub Worksheet_Deactivate()
' checks protection state, performs batch validation if agreed by user, and restores normal PASTE behaviour
' writes a red reminder into cell A4 if sheet is left unvalidated/unprotected
Dim RetVal As Integer
    If Not Me.ProtectContents Then
        RetVal = MsgBox("Protection is currently turned off; sheet may contain inconsistent data" & vbCrLf & vbCrLf & _
                        "Press OK to validate sheet and protect" & vbCrLf & _
                        "Press CANCEL to continue at your own risk without protection and validation", vbExclamation + vbOKCancel, "Validation")
        If RetVal = vbOK Then
            ' silent batch validation
            Application.ScreenUpdating = False
            Sheet_X_BatchValidate Me
            Application.ScreenUpdating = True
            Me.Cells(1, 4) = ""
            Me.Cells(1, 4).Interior.ColorIndex = xlColorIndexNone
            SetProtectionMode Me, True
        Else
            Me.Cells(1, 4) = "unvalidated"
            Me.Cells(1, 4).Interior.ColorIndex = 3 ' red
        End If
    ElseIf Me.Cells(1, 4) = "unvalidated" Then
        ' silent batch validation  ... user manually turned back protection
        SetProtectionMode Me, False
        Application.ScreenUpdating = False
        Sheet_X_BatchValidate Me
        Application.ScreenUpdating = True
        Me.Cells(1, 4) = ""
        Me.Cells(1, 4).Interior.ColorIndex = xlColorIndexNone
        SetProtectionMode Me, True
    End If
    ' important !! restore normal PASTE behaviour
    Application.CommandBars("Edit").Controls("Paste").OnAction = ""
    Application.CommandBars("Edit").Controls("Paste Special...").OnAction = ""
    Application.CommandBars("Cell").Controls("Paste").OnAction = ""
    Application.CommandBars("Cell").Controls("Paste Special...").OnAction = ""
    Application.OnKey "^v"
End Sub

模块 Sheet_X_Functions 基本上包含特定于该工作表的验证子。请注意这里 Enum 的使用 - 它确实为我带来了回报 - 特别是在 Sheet_X_ValidateRow 例程中 - 用户迫使我改变它 100 次；）

' module Sheet_X_Functions
Sub Sheet_X_BatchValidate(MySheet As Worksheet)
Dim VRow As Range
    For Each VRow In MySheet.Rows
        If VRow.Row > T_Sheet_X.NofHRows And VRow.Row <= T_Sheet_X.MaxData Then
            Sheet_X_ValidateRow VRow, False ' silent validation
        End If
    Next
End Sub

Sub Sheet_X_ValidateRow(MyLine As Range, Verbose As Boolean)
' Verbose: TRUE .... display message boxes; FALSE .... keep quiet (for batch validations)
Dim IsValid As Boolean, Idx As Long, ProfSum As Variant

    IsValid = True
    If ContainsData(MyLine, T_Sheet_X.NofCols) Then
        If MyLine.Cells(1, T_Sheet_X.Country) = "" Or _
           MyLine.Cells(1, T_Sheet_X.City) = "" Or _
           MyLine.Cells(1, T_Sheet_X.SiteType) = "" Then
            If Verbose Then MsgBox "Site information incomplete", vbCritical + vbOKOnly, "Row validation"
            IsValid = False
        ' ElseIf otherstuff
        End If

        ' color code the validation result in 1st column
        If IsValid Then
            MyLine.Cells(1, 1).Interior.ColorIndex = xlColorIndexNone
        Else
            MyLine.Cells(1, 1).Interior.ColorIndex = 3  'red
        End If

    Else
        ' empty lines will resolve to valid, remove all color marks
        MyLine.Cells(1, 1).EntireRow.Interior.ColorIndex = xlColorIndexNone
    End If

End Sub

支持从上述代码调用的 CommonFunctions 模块中的 Sub/Functions

' module CommonFunctions
Sub TrappedPaste()
    If ActiveSheet.ProtectContents Then
        ' as long as sheet is protected, we don't paste at all
        MsgBox "Sheet is protected, all Paste/PasteSpecial functions are disabled." & vbCrLf & _
               "At your own risk you may unprotect the sheet." & vbCrLf & _
               "When unprotected, all Paste operations will implicitely be done as PasteSpecial/Values", _
               vbOKOnly, "Paste"
    Else
        ' silently do a PasteSpecial/Values
        On Error Resume Next ' trap error due to empty buffer or other peculiar situations
        Selection.PasteSpecial xlPasteValues
        On Error GoTo 0
    End If
End Sub

' module CommonFunctions
Sub SetProtectionMode(MySheet As Worksheet, ProtectionMode As Boolean)
' care for consistent protection
    If ProtectionMode Then
        MySheet.Protect DrawingObjects:=True, Contents:=True, _
                        AllowSorting:=True, AllowFiltering:=True
    Else
        MySheet.Unprotect
    End If
End Sub

' module CommonFunctions
Function ContainsData(MyLine As Range, NOfCol As Integer) As Boolean
' returns TRUE if any field between 1 and NOfCol is not empty
Dim Idx As Integer

    ContainsData = False
    For Idx = 1 To NOfCol
        If MyLine.Cells(1, Idx) <> "" Then
            ContainsData = True
            Exit For
        End If
    Next Idx
End Function

一件重要的事情是 Selection_Change。如果工作表受到保护，我们要验证用户刚刚离开的行。因此，我们必须跟踪我们来自的行号，因为 TARGET 参数引用新的选择。

如果不受保护，用户可以跳到标题行并开始乱搞（尽管有单元格锁，但是......），所以我们只是不让他/她将光标放在那里。

' objects in Sheet_X
Dim Sheet_X_CurLine As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' trap initial move to sheet
    If Sheet_X_CurLine = 0 Then Sheet_X_CurLine = Target.Row

    ' don't let them select any header row    
    If Target.Row <= T_Sheet_X.NofHRows Then
        Me.Cells(T_Sheet_X.NofHRows + 1, Target.Column).Select
        Sheet_X_CurLine = T_Sheet_X.NofHRows + 1
        Exit Sub
    End If

    If Me.ProtectContents And Target.Row <> Sheet_X_CurLine Then
        ' if row is changing while protected
        ' validate old row
        Application.ScreenUpdating = False
        SetProtectionMode Me, False
        Sheet_X_ValidateRow Me.Rows(Sheet_X_CurLine), True ' verbose validation
        SetProtectionMode Me, True
        Application.ScreenUpdating = True
    End If

    ' in any case make the new row current
    Sheet_X_CurLine = Target.Row
End Sub

Sheet_X 中也有一个 Worksheet_Change 代码，我在其中根据其他单元格的输入动态地将值加载到当前行的字段下拉列表中。由于这是非常具体的，我只在这里展示框架，重要的是暂时挂起事件处理以避免递归调用更改触发器

Private Sub Worksheet_Change(ByVal Target As Range)
Dim IsProtected As Boolean

    ' capture current status
    IsProtected = Me.ProtectContents

    If Target.Row > T_FR.NofHRows And IsProtected Then  ' don't trigger anything in header rows or when protection is turned off

        SetProtectionMode Me, False         ' because the trigger will change depending fields
        Application.EnableEvents = False    ' suspend event processing to prevent recursive calls

        Select Case Target.Column
            Case T_Sheet_X.CtyCode
                ' load cities applicable for country code entered
        ' Case T_Sheet_X. ... other stuff
        End Select

        Application.EnableEvents = True    ' continue event processing
        SetProtectionMode Me, True
    End If
End Sub

就是这样......希望这篇文章对你们中的一些人有用

祝你好运麦克D