Excel-复杂验证策略

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

如果你在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

我有一个类似的项目,在那里我使用了捕获粘贴事件和强制使用正义值的PasteSpecial。它保留格式和条件格式/数据验证,但允许用户粘贴值。但它会破坏撤消粘贴的功能。

这是我想到的(所有Excel2003)

我的工作簿中所有需要复杂验证的工作表都是以表格形式组织的,其中有几行标题包含工作表标题和列标题。最后一列右边的所有列都是隐藏的,低于实际限制的所有行(在我的例子中是200行)也都是隐藏的。我已经设置了以下模块:

• 全球…枚举类型
• 通用函数…函数由使用 所有纸张
• 工作表功能…功能 单张纸
• 表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

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

此线程中的建议是捕获粘贴活动。Excel-2003中的事件触发器并不真正支持,但最终不是一个大奇迹。捕获/取消捕获粘贴在工作表X的激活/停用事件中发生。在停用时,我还检查保护状态。如果不受保护,我要求用户同意批验证并重新保护。单行验证和批验证例程是模块工作表中的代码对象,下面将进一步介绍这些功能。

' 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_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

支持从上述代码调用的模块公共函数中的子/函数

' 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

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

如果不受保护,用户可以跳进标题行并开始乱转(尽管有单元格锁,但是….),所以我们不让他/她把光标放在那里。

' 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

在工作表X中也有一个工作表“更改代码”,在这里,我会根据其他单元格的条目动态地将值加载到当前行字段的下拉列表中。因为这是非常具体的,所以我在这里展示了框架,这对于临时挂起事件处理以避免递归调用更改触发器很重要。

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

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

祝好运

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

我倾向于编写简单的子函数来打开和关闭这些东西(例如,使用一个名为“enabled”的参数,这样就可以调用它来关闭和再次打开。

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