我需要在单元格更改时验证用户输入，并使用VBA在Excel中的另一个单元格中显示错误。
当用户插入使Excel长时间没有响应的行或列时，我会遇到问题，即在工作表中的所有单元格上调用验证器，我该如何解决这个问题？
以下是我的要求以及我当前的完整文档解决方案。
考虑下表： Example User Input Table
| | | 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 |
| | | | | |
这个想法是用户在表中输入值，一旦值被更改（用户离开单元格），该值就会被验证，如果出现问题，则会在Note列中打印错误。
应忽略空行。
我需要它是健壮的，这意味着它不应该在任何用户输入上失败，这意味着它必须适用于以下情况：
*当用户删除属于表的一部分的列时验证失败，因为这被视为用户故意破坏工作表，但它必须正常失败（即不能通过验证所有单元格）在工作表中需要很长时间）。 如果这个动作是可以撤销的，那将是很棒的，但是我目前对Excel的理解表明这是不可能的（在宏改变了工作表中的某些内容之后，任何事情都无法撤消）。
Note单元格一次只能包含一个错误，对于用户而言，最相关的错误是用户上次更改的单元格错误，因此它应首先显示此错误。在用户修复该错误之后，订单不再重要，因此它可以从左到右显示错误。
我的问题是，当插入行/列时，会对工作表中的所有单元格触发验证，这是一个非常慢的过程，对于用户来说，程序看起来已经崩溃了，但是一旦验证完成就会返回。 我不知道为什么Excel会这样做，但我需要一种方法来解决它。
我的解决方案基于我所知道的唯一更改事件处理程序：每张表单全局Worksheet_Change函数（呃！）。
首先，它检查更改的单元格是否与对验证感兴趣的单元格相交。这项检查实际上非常快。
OldRowCount这里试图捕捉用户插入或删除单元格，具体取决于使用的范围如何变化，但是这只能解决一些情况，并在Excel忘记全局变量时引入问题（现在发生这种情况，对于我来说不明原因）以及第一次运行该功能。
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
定义要验证的行/列。
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"
此函数验证给定的单元格，除非单元格所在的行为空。
这意味着我们只对在用户实际开始给出值的行上验证单元格感兴趣。空行不是问题。 它首先验证当前更改的单元格，如果可以，它将验证给定行上的其他单元格（因为某些单元格验证取决于其他单元格的值，请参阅上面示例表中启用的容差）。
该注释一次只包含一条错误消息，上面的操作完成后我们总是得到Note单元格中最后一个更改单元格的错误。
是的，这将使检查器在当前单元格上运行两次，而这不是一个问题，可以通过更复杂的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
这些功能需要一行，并根据其特殊要求验证某列。如果验证失败，则返回一个字符串。
' 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 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
代码已经过测试，必须适用于Excel 2010及更高版本。
为清晰起见而编辑
答案 0 :(得分：2)
在经历了相当多的痛苦之后，事实证明修复非常简单。
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
' 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