Excel – 复杂validation的策略
我似乎有一个困境。 我有一个用户应该用来填写表格信息的EXCEL 2003模板。 我对各种单元格进行validation，每一行在更改和selection_change事件时都会经历相当复杂的VBAvalidation。 工作表受到保护，不允许格式化活动，插入和删除行和列等
只要用户逐行填写表格，所有工作都很好。 如果我想允许用户将数据复制/粘贴到表单中（在这种情况下这是一个合法的用户需求），情况会变得更糟，因为单元validation将不允许粘贴操作。
所以我试图让用户closures保护和剪切/粘贴，VBA标记表单，以表明它包含未经validation的条目。 我创build了一个“批量validation”，一次validation所有非空行。 仍然复制/粘贴不太好（必须直接从源表跳转到目标，不能从文本文件粘贴等）
单元validation在插入行的方面也不是很好，因为根据插入行的位置，单元validation可能完全丢失。 如果我将单元格validation复制到第65k行，则空白表格的大小将超过2M，这是另一个不必要的副作用。
所以我认为避免麻烦的方法之一就是忘掉所有的单元validation，只使用VBA。 然后，我会牺牲用户在某些列中提供下拉列表的舒适度 – 其中一些列也会根据其他列中的条目而变化。
有没有人曾经在相同的情况之前，可以给我一些（通用）的战术build议（编码VBA不是问题）？
亲切的问候MikeD
我相信有可能捕获“粘贴”事件。 我不记得语法，但它会给你一个“数组单元”被复制，以及单元格被复制的左上angular的单元格。
如果你用vba修改一个单元格的值，你根本不需要closuresvalidation – 所以我会做的是（对不起，伪代码，我的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公正的价值观。 这保留了格式和条件格式/数据validation，但允许用户粘贴值。但是，它会破坏粘贴的能力。
这是我想出的（所有Excel 2003）
我的工作簿中所有需要进行复杂validation的工作表都以表格的forms组织成一对包含工作表标题和列标题的标题行。 最后的所有列都是隐藏的，低于实际限制的所有行（在我的情况下是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
首先我描述事件触发的代码。
在这个线程中的build议是陷阱PASTE活动。 在Excel-2003中没有真正被事件触发器支持，但最终不是一个很大的奇迹。 在Sheet_X中激活/取消激活事件时会发生陷印/解除粘贴。 在closures时我也检查保护状态。 如果不加保护，我要求用户同意批量validation并重新保护。 然后单线validation和批validation例程是模块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基本上包含特定于该工作表的validation子。 注意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。 如果工作表受到保护，我们要validation用户刚刚离开的行。 因此，我们必须跟踪我们来自哪里的行号，因为TARGET参数指向NEWselect。
如果不加保护，用户可以跳到标题行并开始搞乱（虽然有单元格锁，但是…），所以我们不要把他/她的光标放在那里。
' 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代码，在这里我根据其他单元格的条目dynamic地将值加载到当前行的下拉列表中。 由于这是非常具体的，我只是在这里提出的框架，重要的是暂时挂起事件处理，以避免recursion调用更改触发器
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
我个人认为，从根本上来说，在excel中使用cut'n'pastefunction是一个糟糕的主意，而且往往会产生意想不到的后果，比如破坏撤销。 由于可以通过代码添加数据validation，所以为什么不在粘贴之后重新添加到问题表单呢？ 这也可以解决你插入行的附带问题等
我倾向于编写简单的子接口来打开和closures这些东西（例如，使用一个名为“enabled”的参数，因此可以调用它closures并再次打开。
在工作表更改事件中，您可以遍历每个单元格并强制进行数据validation（例如，对于非空单元格，以防止在插入新行时出现大量失火），并清除每个未通过validation的粘贴单元格。 为了使这个过程对用户来说更友好一点，我们倾向于在清除失败的值之前给单元格添加注释，并更改单元格的背景颜色，以便用户知道需要修复的位（显然，使用对应的“清除所有注释”例程在下一次validation后运行。