突出显示不符合下拉标准的单元格
突出显示不符合下拉标准的单元格
提问于 2022-03-09 13:56:22
我有一个电子表格，它有下拉选项，人们一直在复制和粘贴不适合下拉选项的条目。
我创建了一个VBA，用于扫描工作表，并在单元格中显示一条错误消息，其中有不适合下拉选项的条目。我只需要用黄色高亮显示那些需要改变的细胞，这样就可以很容易地找到它们。有人能帮忙吗？
这是我现在的VBA：
Sub TestValidation()
Dim myRng As Range
Dim ErrorMsg As String
Dim NoErrorMsg As String
Dim FoundCells As String
Dim cell As Range
Set myRng = Sheets("Portfolio Tracker").Range("D3:AK5000")
ErrorMsg = "You've entered something in a drop-down box cell that isn't a drop-down box option. Please change"
NoErrorMsg = "No cells that do not abide to validation"
FoundCells = ""
For Each cell In myRng
If Not cell.Validation.Value Then
FoundCells = FoundCells & "," & cell.Address
End If
Next cell
If Len(FoundCells) >= 1 Then
MsgBox ErrorMsg & Right(FoundCells, Len(FoundCells) - 1)
Else
MsgBox NoErrorMsg
End If
Set myRng = Nothing
End Sub回答 2
Stack Overflow用户
回答已采纳
发布于 2022-03-09 14:24:55
您可以使用Worksheet_Change事件，如果有人粘贴无效的值，它将撤消粘贴并抛出一条消息。
请注意，除了这个过程之外，还需要使用DataValidation。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RevertChanges As Boolean
Const WatchedRange As String = "D3:AK5000"
On Error GoTo ENABLE_EVENTS ' in case of error enable events
Application.EnableEvents = False
Dim AffectedCells As Range
Set AffectedCells = Intersect(Target, Me.Range(WatchedRange))
If Not AffectedCells Is Nothing Then
Dim ValidationType As Variant
ValidationType = AffectedCells(1).Validation.Type
If Not IsEmpty(ValidationType) Then
Dim Cell As Range
For Each Cell In AffectedCells
If Cell.Value <> "" Then
If Not Cell.Validation.Value Then
RevertChanges = True
Exit For
End If
End If
Next Cell
Else
RevertChanges = True
End If
If RevertChanges Then
MsgBox "Invalid values were pasted. Undo pasting.", vbCritical, "Computer Says No"
Application.Undo
End If
End If
ENABLE_EVENTS:
Application.EnableEvents = True
End Sub或者，只需对下拉列表使用数据验证，然后使用Sheets("Portfolio Tracker").CircleInvalid圈出无效的值：
Stack Overflow用户
发布于 2022-03-09 14:41:50
如果只想对无效的单元格着色，可以在第一个If条件中添加cell.Interior.Color = 65535。
If Not cell.Validation.Value Then
cell.Interior.Color = 65535
FoundCells = FoundCells & "," & cell.Address
End If页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/71410481
复制相关文章
相似问题
腾讯云开发者
