1

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

我目前的做法是这样的：

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 函数将行和字段值作为参数并返回列号。由于我使用的是固定字段值，因此如果字段已更改，则此操作失败，因此我的联合调用失败。

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

4

2 回答 2

2

除了我的评论

例 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
于 2013-04-18T09:34:09.887 回答
1

如果您不希望公式对单元格中的用户可见，他们可能不会更改，您也可以勾选隐藏。

VBA解决方案

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

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

  2. 为 Worksheet_Change(Target) 创建一个脚本，该脚本将Target通过在工作表副本中查找目标范围内所有单元格的行/列坐标来检查范围是否最初包含特殊值之一。如果它包含一个特殊值，您只需将该值从您的工作表副本中放回。这主要是您已经拥有的脚本...

工作表保护解决方案

您是否考虑过使用工作表保护（Review > Protect Sheet）并仅在允许用户更改的那些单元格上解锁保护？这样，您无需额外编码就可以控制它......也许这些单元格的位置有一些逻辑，您已经可以预先使用？或者在您的脚本每次更改后，您将运行一个 VBA 脚本来查找具有这些值的所有单元格并设置锁定属性 = True，然后再次应用工作表保护。

手动设置单个单元格或范围的保护锁定，方法是右键单击 > 格式化单元格 > 保护 > 勾选锁定旁边的框

于 2013-04-18T08:19:00.597 回答