Excel - 复杂验证的策略

Question

我似乎陷入了两难境地。我有一个 EXCEL 2003 模板，用户应该使用它来填写表格信息。我对各种单元格进行了验证，并且每一行在更改和 selection_change 事件时都经历了相当复杂的 VBA 验证。工作表被保护以禁止格式化活动、插入和删除行和列等。

只要用户逐行填写表格，一切正常。如果我想允许用户将数据复制/粘贴到该工作表中（在这种情况下这是合法的用户需求），情况会变得更糟，因为单元格验证将不允许粘贴操作。

所以我试图让用户关闭保护和剪切/粘贴，VBA 标记工作表以表明它包含未经验证的条目。我创建了一个“批量验证”，一次验证所有非空行。仍然复制/粘贴效果不太好（必须直接从源工作表跳转到目标，不能从文本文件粘贴等）

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

所以我认为避免麻烦的一种方法是完全忘记单元格验证，而只使用 VBA。然后我会牺牲用户在某些列中提供下拉列表的舒适度——其中一些也会随着其他列中的条目而变化。

以前有没有人遇到过同样的情况，可以给我一些（通用的）战术建议（编码 VBA 不是问题）？

亲切的问候 迈克D

Answer 1

我相信可以捕获“粘贴”事件。我不记得语法，但它会给你一个要复制的“单元格数组”，以及要复制单元格的左上角单元格。

如果您在 vba 中修改单元格的值，则根本不需要停用验证 - 所以我要做的是（抱歉，伪代码，我的 VBA 有点生锈）

OnPaste(cells, x, y)
  for each cell in cells do
    obtain the destinationCell (using the coordinates of cell on Cells, plus x and y)
    check if the value in cell is "valid" with destinationCell's validations
    if not valid, alert a message
    if valid, destinationCell.value = cell.value
  end
end

Answer 2

我有一个类似的项目，我采取了捕获粘贴事件并强制粘贴特殊值的方法。这保留了格式和条件格式/数据验证，但允许用户粘贴值。但它确实破坏了撤消粘贴的能力。

Answer 3

这是我想出的（所有 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

Module Sheet_X_Functions 基本上包含特定于该表的验证 Sub。注意这里 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 参数指的是 NEW 选择。

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

' 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

Answer 4

我个人认为，从根本上搞乱 excel 中的剪切粘贴功能是一个坏主意，而且通常会产生意想不到的后果，例如破坏撤消。既然可以通过代码添加数据验证，那么为什么不在粘贴后将其重新添加到相关工作表中呢？这也将解决您插入行等的附带问题。

我倾向于编写简单的子程序来打开和关闭这些东西（例如，使用名为“启用”的参数，因此可以调用它来关闭和再次打开。

在工作表更改事件中，您可以遍历每个单元格并强制进行数据验证（例如，非空单元格以防止在插入新行时出现大量错误）并清除每个未通过验证的粘贴单元格.为了让这个过程对用户更友好一点，我们倾向于在清除失败值之前向单元格添加注释，并更改单元格的背景颜色，以便用户知道他们需要修复哪些位（显然使用下一次验证后运行相应的“清除所有 cmets”例程。