Question

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

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

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

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

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

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

亲切的问候拾音

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本身的事件触发器

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

' 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中的激活/取消激活事件中。 On Deactivate我也检查保护状态。如果不受保护，我会要求用户同意批量验证并重新保护。然后，单行验证和批处理验证例程是下面描述的模块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基本上包含特定于该工作表的验证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

支持从上面的代码中调用的模块CommonFunction中的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代码，我根据其他单元格的条目动态地将值加载到当前行的字段的下拉列表中。由于这是非常具体的，我只是在这里呈现框架，重要的是临时暂停事件处理以避免对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

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

祝你好运MikeD

Answer 4

我个人认为从根本上与excel中的cut'n'paste功能混乱是一个坏主意 - 并且经常会产生意想不到的后果，例如破坏撤消。由于可以通过代码添加数据验证，因此为什么不在粘贴后将其重新添加到相关工作表中？这也将解决您插入行等的偶然问题。

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

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

Excel - 复杂验证的策略

4 个答案: