Excel VBA中完美的用户inputvalidation

我需要在单元格更改时validation用户input，并使用VBA在Excel中的另一个单元格中显示错误。

我碰到问题，当用户插入使Excel长时间没有响应的行或列时，表单中的所有单元格都会调用validation器，我该如何解决这个问题？

以下是我的要求和我目前的解决scheme，完整的文档。

定义和要求

考虑下表： 示例用户input表

| | | Tolerance | | | | Type | Length | enabled | Tolerance | Note | |------|--------|-----------|-----------|----------------------------| | | 4 | 0 | | Type is missing | | | | 0 | | Type is missing | | C | 40 | 1 | 110 | | | D | 50 | 1 | | Tolerance is missing | | | | | | | 

这个想法是，用户在表格中input值，一旦一个值被改变（用户离开单元格），该值被validation，如果有问题，错误将被打印在注释列中。

空行应该被忽略。

我需要这是强大的，这意味着它不应该在任何用户input失败，这意味着它必须为以下情况下工作：

• 粘贴值
• 删除行
• 插入行（空或切单元格）
• 插入/删除列*
• 任何其他情况下，我错过了思考？

*当用户删除属于表的列时，validation失败是可以的，因为这被视为用户故意破坏工作表，但它必须优雅地失败（即不是通过validation工作表中的所有单元格这需要很长时间）。 如果这个行为是可撤销的，那将是非常好的，但是我现在对Excel的理解表明这是不可能的（在一个macros改变了表中的东西之后，什么都不能撤销）。

Note单元一次只能包含一个错误，对于用户来说，最相关的错误是用户上次更改单元格的错误，所以它应该首先显示该错误。 用户修复该错误后，顺序不再那么重要，所以它只能从左到右显示错误。

目前的方法存在问题

我的问题是，当插入行/列时，会触发表格中所有单元格的validation，这是一个非常缓慢的过程，对用户来说，程序看起来已经崩溃，但validation完成后将返回。 我不知道为什么Excel这样做，但我需要一种方法来解决它。

置于名为“用户input”的工作表中的代码

我的解决scheme是基于我所知道的change事件处理程序：每个工作表全局Worksheet_Change函数（唉！）。

Worksheet_Changefunction

首先它检查改变的单元格是否与我感兴趣的单元格相交。 这个检查其实很快。

OldRowCount这里试图捕获用户插入或删除单元格取决于如何使用的范围更改，但是这只能解决一些情况下，并引入问题，每当Excel忘记全局variables（这是因为我不明原因发生），作为以及第一次运行该function。

for循环使其适用于粘贴的值。

 Option Explicit Public OldRowCount As Long ' Run every time something is changed in the User Input sheet, it then filters on actions in the table Private Sub Worksheet_Change(ByVal Target As Range) Dim NewRowCount As Long NewRowCount = ActiveSheet.UsedRange.Rows.count If OldRowCount = NewRowCount Then If Not Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) Is Nothing Then Dim myCell As Range ' This loop makes it work if multiple cells are changed, for example while pasting cells For Each myCell In Target.Cells ' Protect the header rows If myCell.row >= ROW_FIRST Then checkInput_cell myCell.row, myCell.Column, Me End If Next End If ElseIf OldRowCount > NewRowCount Then 'Row deleted, won't have to deal with this as it solves itself OldRowCount = NewRowCount ElseIf OldRowCount < NewRowCount Then Debug.Print "Row added, TODO: deal with this" OldRowCount = NewRowCount End If End Sub 

代码放置在模块中

全局variables

定义要validation的行/列。

 Option Explicit ' User input sheet set up Public Const ROW_FIRST = 8 Public Const COL_TYPE = "B" Public Const COL_LENGTH = "C" Public Const COL_TOLERANCE_ENABLED = "D" Public Const COL_TOLERANCE = "E" Public Const COL_NOTE = "G" 

单元格检查function

此函数validation给定的单元格，除非单元格所在的行是空的。

这意味着我们只关心validation用户实际开始赋值的行上的单元格。 空行不是问题。 它首先validation当前更改的单元格，如果它是好的，那么将validation给定行上的其他单元格（因为某些单元格validation取决于其他单元格的值，请参阅上面示例表格中启用的容差）。

笔记一次只会包含一个错误信息，上面这样做是为了让我们总是得到注释单元中最后一个被改变的单元的错误。

是的，这将使检查器在当前单元格上运行两次，而这不是一个可以通过更复杂的if语句来避免的问题，但是为了简单起见，我跳过了它。

 Sub checkInput_cell(thisRow As Long, thisCol As Long, sheet As Worksheet) Dim note As String note = "" With sheet ' Ignore blank lines If .Range(COL_TYPE & thisRow).value <> "" _ Or .Range(COL_LENGTH & thisRow).value <> "" _ Or .Range(COL_TOLERANCE_ENABLED & thisRow).value <> "" _ Or .Range(COL_TOLERANCE & thisRow).value <> "" _ Then ' First check the column the user changed If col2Let(thisCol) = COL_TYPE Then note = check_type(thisRow, sheet) ElseIf col2Let(thisCol) = COL_LENGTH Then note = check_length(thisRow, sheet) ElseIf col2Let(thisCol) = COL_TOLERANCE_ENABLED Then note = check_tolerance_enabled(thisRow, sheet) ElseIf col2Let(thisCol) = COL_TOLERANCE Then note = check_tolerance(thisRow, sheet) End If ' If that did not result in an error, check the others If note = "" Then note = check_type(thisRow, sheet) If note = "" Then note = check_length(thisRow, sheet) If note = "" Then note = check_tolerance_enabled(thisRow, sheet) If note = "" Then note = check_tolerance(thisRow, sheet) End If ' Set note string (done outside the if blank lines checker so that it will reset the note to nothing on blank lines) ' only change it actually set it if it has changed (optimization) If Not .Range(COL_NOTE & thisRow).value = note Then .Range(COL_NOTE & thisRow).value = note End If End With End Sub 

各个列的validation程序

这些函数根据它的特殊要求取一行并validation某一列。 如果validation失败，则返回一个string。

 ' Makes sure that type is : ' Unique in its column ' Not empty Function check_type(affectedRow As Long, sheet As Worksheet) As String Dim value As String Dim duplicate_found As Boolean Dim lastRow As Long Dim i As Long duplicate_found = False value = sheet.Range(COL_TYPE & affectedRow).value check_type = "" ' Empty value check If value = "" Then check_type = "Type is missing" Else ' Check for uniqueness lastRow = sheet.Range(COL_TYPE & sheet.Rows.count).End(xlUp).row If lastRow > ROW_FIRST Then For i = ROW_FIRST To lastRow If Not i = affectedRow And sheet.Range(COL_TYPE & i).value = value Then duplicate_found = True End If Next End If If duplicate_found Then check_type = "Type has to be unique" Else ' OK End If End If End Function ' Makes sure that length is a whole number larger than -1 Function check_length(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_LENGTH & affectedRow).value check_length = "" If value = "" Then check_length = "Length is missing" ElseIf IsNumeric(value) Then If Not Int(value) = value Then check_length = "Length cannot be decimal" ElseIf value < 0 Then check_length = "Length is below 0" ElseIf InStr(1, value, ".") > 0 Then check_length = "Length contains a dot" Else ' OK End If ElseIf Not IsNumeric(value) Then check_length = "Length is not a number" End If End Function ' Makes sure that tolerance enabled is either 1 or 0: Function check_tolerance_enabled(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value check_tolerance_enabled = "" If Not value = "0" And Not value = "1" Then check_tolerance_enabled = "Tolerance enabled has to be 1 or 0" Else ' OK End If End Function ' Makes sure that tolerance is a whole number larger than -1 ' But only checks tolerance if it is enabled in the tolerance enabled column Function check_tolerance(affectedRow As Long, sheet As Worksheet) As String Dim value As String value = sheet.Range(COL_TOLERANCE & affectedRow).value check_tolerance = "" If value = "" Then If sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value = 1 Then check_tolerance = "Tolerance is missing" End If ElseIf IsNumeric(value) Then If Not Int(value) = value Then check_tolerance = "Tolerance cannot be decimal" ElseIf value < 0 Then check_tolerance = "Tolerance is below 0" ElseIf InStr(1, value, ".") > 0 Then check_tolerance = "Tolerance contains a dot" Else ' OK End If ElseIf Not IsNumeric(value) Then check_tolerance = "Tolerance is not a number" End If End Function 

寻址支持function

这些function将字母翻译成列，反之亦然。

 Function let2Col(colStr As String) As Long let2Col = Range(colStr & 1).Column End Function Function col2Let(iCol As Long) As String Dim iAlpha As Long Dim iRemainder As Long iAlpha = Int(iCol / 27) iRemainder = iCol - (iAlpha * 26) If iAlpha > 0 Then col2Let = Chr(iAlpha + 64) End If If iRemainder > 0 Then col2Let = col2Let & Chr(iRemainder + 64) End If End Function 

代码经过testing/必须适用于Excel 2010及更高版本。

编辑清晰

Answer 1

终于搞定了

经过相当多的苦恼之后，结果certificate这个解决方法非常简单。

• 我添加了一个新的testing，通过查看范围的地址来检查用户改变的区域（目标范围）是否由一个列组成，如果它是一个完整的列，检查器将忽略它。 这解决了Excelvalidation花费大约一分钟的问题。
• 交点计算的结果用于内部循环，该循环将检查限制在我们有兴趣validation的区域内的单元格。

修复了Worksheet_Changefunction

 Option Explicit ' Run every time something is changed in the User Input sheet Private Sub Worksheet_Change(ByVal Target As Range) Dim InterestingRange As Range Set InterestingRange = Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) If Not InterestingRange Is Nothing Then ' Guard against validating every cell in an inserted column If Not RangeAddressRepresentsColumn(InterestingRange.address) Then Dim myCell As Range ' This loop makes it work if multiple cells are changed, ' for example when pasting cells For Each myCell In InterestingRange.Cells ' Protect the header rows If myCell.row >= ROW_FIRST Then checkInput_cell myCell.row, myCell.Column, Me End If Next End If End If End Sub 

新的支持function

 ' Takes an address string as input and determines if it represents a full column ' A full column is on the form $A:$A for single or $A:$C for multiple columns ' The unique characteristic of a column address is that it has always two ' dollar signs and one colon Public Function RangeAddressRepresentsColumn(address As String) As Integer Dim dollarSignCount As Integer Dim hasColon As Boolean Dim Counter As Integer hasColon = False dollarSignCount = 0 ' Loop through each character in the string For Counter = 1 To Len(address) If Mid(address, Counter, 1) = "$" Then dollarSignCount = dollarSignCount + 1 ElseIf Mid(address, Counter, 1) = ":" Then hasColon = True End If Next If hasColon And dollarSignCount = 2 Then RangeAddressRepresentsColumn = True Else RangeAddressRepresentsColumn = False End If End Function