VBA仅参考初始单元格值来阻止用户更改单元格值

Question

我正在尝试停止某些字段被用户更改。但是，我不知道这些字段将包含哪些列，只知道它们最初将包含哪些值。

我目前的做法是：

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

上面代码中的My ColumnNumber函数将行和字段值作为参数并返回列号。由于我使用的是固定字段值，如果字段已更改，则会失败，因此我的联合调用失败。

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

Answer 1

继续我的评论

示例1

创建名为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解决方案

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

1. 第一阶段将保存工作表的副本（隐藏）工作表，以便在对该工作表进行更改后以及在第2阶段运行后进行参考。

2. 创建用于Worksheet_Change（目标）的脚本，将检查Target范围最初包含特殊值的一个通过查找行/列在目标范围内协调所有单元的工作表副本。如果它包含特殊值，您只需将该值从表单副本中恢复。这主要是你已经拥有的剧本......

工作表保护解决方案

您是否考虑过使用工作表保护（评论＆gt;保护表）并仅对允许用户更改的单元格启用保护？这样你就可以在没有额外编码的情况下控制它...也许这些单元格的某些逻辑是你已经可以预先使用的？或者在脚本每次更改后，您将运行VBA脚本以查找具有这些值的所有单元格并设置locked属性= True，然后再次应用Worksheet保护。

通过右键单击＆gt;手动设置单个单元格或范围的保护锁定。格式单元格＆gt;保护＆gt;勾选已锁定

旁边的框