VBA仅参考初始单元格值，防止用户更改单元格值

我试图阻止用户更改某些字段。 但是，我不知道这些字段将在哪些列，只有他们最初将包含的价值。

我目前的做法是这样的：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim columnHeaderRange As Range Set shtData = Worksheets("Data") Set columnHeaderRange = Union(shtData.Columns(ColumnNumber(5, "example1")), _ shtData.Columns(ColumnNumber(5, "example2")), _ shtData.Columns(ColumnNumber(5, "example3"))) Set columnHeaderRange = Application.Intersect(Target, columnHeaderRange) ElseIf Not (columnHeaderRange Is Nothing) Then With Application .EnableEvents = False .Undo MsgBox "Change is not possible.", 16 .EnableEvents = True End With Else Exit Sub End If 

上面代码中的ColumnNumber函数将行和字段值作为参数，并返回列号。 因为我使用的是固定字段值，所以如果一个字段被改变了，所以我的联合调用失败了。

有没有办法让这个代码运行在用户尝试更改单元格的值，但在单元格的实际值更改之前？ 或者任何人都可以提出更好的方法？

Answer 1

继我的评论

例1

创build一个名为List ，它将存储您的值。 关于这种方法的最好的部分是，你不必每次你想要添加/删除列表中的项目时修改代码。

看截图

假设这是你的主要表格

将此代码粘贴到“工作表代码区”中

 Dim rngList As Range, aCell As Range Dim RowAr() As Long Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long On Error GoTo Whoa Application.EnableEvents = False For Each aCell In Target If aCell.Row = 5 Then With Application For i = LBound(RowAr) To UBound(RowAr) If RowAr(i) = aCell.Column Then MsgBox "Change is not possible." .Undo GoTo Letscontinue End If Next End With End If Next Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wsList As Worksheet Dim n As Long, lrow As Long Set wsList = ThisWorkbook.Sheets("list") With wsList lrow = .Range("A" & .Rows.Count).End(xlUp).Row Set rngList = .Range("A1:A" & lrow) End With n = 0 ReDim RowAr(n) For Each aCell In Range("5:5") If Len(Trim(aCell.Value)) <> 0 Then If Application.WorksheetFunction.CountIf(rngList, aCell.Value) > 0 Then n = n + 1 ReDim Preserve RowAr(n) RowAr(n) = aCell.Column Debug.Print aCell.Column End If End If Next End Sub 

行动中的代码

例2

这使用硬编码列表。

 Option Explicit Dim RowAr() As Long, aCell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim MyList As String, MyAr() As String Dim n As Long, i As Long '~~> This is the list MyList = "Header 1,Header 2" MyAr = Split(MyList, ",") n = 0 ReDim RowAr(n) For Each aCell In Range("5:5") If Len(Trim(aCell.Value)) <> 0 Then For i = LBound(MyAr) To UBound(MyAr) If aCell.Value = MyAr(i) Then n = n + 1 ReDim Preserve RowAr(n) RowAr(n) = aCell.Column End If Next End If Next End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long On Error GoTo Whoa Application.EnableEvents = False For Each aCell In Target If aCell.Row = 5 Then With Application For i = LBound(RowAr) To UBound(RowAr) If RowAr(i) = aCell.Column Then MsgBox "Change is not possible." .Undo GoTo Letscontinue End If Next End With End If Next Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub 

Answer 2

如果你不想公式的单元格中的用户可见，他们可能不会改变，你也可以勾选隐藏。

VBA解决scheme

你可以有一个2阶段脚本：

1. 第一阶段将保存在（隐藏）工作表中的工作表复印件，以便在对工作表进行更改之后以及在阶段2之后运行。

2. 为Worksheet_Change（Target）创build一个脚本，通过查看工作表副本中目标范围内的所有单元格的行/列坐标来检查Target范围最初是否包含其中一个特殊值。 如果它包含一个特殊的值，你只需要把这个值从你的工作表拷贝。 这主要是你已经有的脚本…

工作表保护解决scheme

您是否考虑过使用工作表保护（“ 审阅”>“保护工作表” ）并仅在允许用户更改的单元上解锁保护？ 这样，你将保持对这个没有额外的编码控制…也许有一些逻辑到这些单元格，你可以已经使用的前沿？ 或者在每次脚本更改之后，您将运行一个VBA脚本来查找具有这些值的所有单元格，并设置locked属性= True ，然后再次应用Worksheet保护。

通过右键>格式化单元格>保护>勾选locking旁边的框 ，手动设置单个单元格或范围的保护locking