☰

如何阻止用户更改单元格但允许 VBA 更改它们

tag-icon • tag-icon microsoft-excel-2003
如何阻止用户更改单元格但允许 VBA 更改它们

我正在使用 Excel 电子表格来记录员工资源。在 B 列中，有一个值“输入您的姓名”，它指示用户从哪里开始输入他们的信息。然后，当用户在此行输入他们的详细信息时，下一行将填充预定义的文本。

不幸的是，有些用户无法遵循这样简单的说明并开始在任何行中输入他们的详细信息。

我如何修改以下代码，以便 B 列中的所有空白行都被锁定，但仍允许 VBA 使用“输入您的姓名”填充相应的单元格？

这是创建文本值的一段代码：

With Target 
    Select Case True              
    Case .Column = 2 
        If .Value2 <> "Enter your name" And .Offset(, -1) = "" Then                  
            Set FirstBlankCell = Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 
            FirstBlankCell.Value = "Enter your name" 
        End If 
    Case Else 
    End Select 
End With

答案1

每当用户更改工作表上单元格的内容时，您可以检查目标列中的单元格中是否存在由 vba 输入的默认文本字符串，如果发现，则提醒用户，或移动他们输入的内容到应该输入的单元格中（这两个操作都在下面的代码中，（移动选项在 IF ELSE 块中被注释掉）：

Const USER_ENTRY_COL = 2                    'Column users should be entering data into
Const TARGET_TEXT = "Enter your name here"  'The default text the VBA code uses to mark the correct cell
Const ENTRY_ROW_NOT_FOUND = -1            'Return value for correct cell search if correct cell cannot be found

Private Sub Worksheet_Change(ByVal Target As Range)
    'do not test if not in user entry column
    If Target.Column <> USER_ENTRY_COL Then Exit Sub

    'do nothing if first cell of target range is empty or is target text,
    'which it would be if macro is flagging cell for user
    If Target.Cells(1, 1).Value = "" Or Target.Cells(1, 1).Value = TARGET_TEXT Then Exit Sub

    Dim rowWithDefaultText As Long
    rowWithDefaultText = find_row_with_default_text(USER_ENTRY_COL)

    If rowWithDefaultText = ENTRY_ROW_NOT_FOUND Then
        'user has overwitten the vba inserted default text,meaning they entered in the right row
    Else
        'Alerts the user and clears what they entered into the wrong cell
        MsgBox "Please enter your information into row " & rowWithDefaultText, vbInformation, "Data Entered in Wrong Row"
        Target.Clear
        Cells(rowWithDefaultText, USER_ENTRY_COL).Activate

''        'Moves whatever the user entered, from the wrong cell into the right cell
''        Dim name As Variant
''        name = Target.Cells(1, 1).Value
''        Target.Clear
''        Cells(rowWithDefaultText, USER_ENTRY_COL).Value = name
    End If
End Sub

'//Finds the correct row that is meant to be used for user entry
'@PARAM colNum - The column number for the column to be searched
Private Function find_row_with_default_text(colNum As Integer) As Long
    Dim CorrectEntryRow As Long
    CorrectEntryRow = find_first_instance_row(TARGET_TEXT, USER_ENTRY_COL, 1, 500)
    find_row_with_default_text = CorrectEntryRow
End Function


'//Cannot be found in the range, then a row value of '-1' will be returned
'@PARAM searchTerm - The value to find the first instance of
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row number for the top of the range to be searched
'@PARAM endAtRow - The row number for the end of the range to be searched
Public Function find_first_instance_row(ByVal searchterm As String, _
                        ByVal colNum As Integer, ByVal startAtRow As Long, _
                        ByVal endAtRow As Long) As Long
    Dim searchRange As Range
    Set searchRange = Range(Cells(startAtRow, colNum), Cells(endAtRow, colNum))
    Dim foundIt As Range
    Set foundIt = searchRange.Find(searchterm, , , xlWhole)
    If Not foundIt Is Nothing Then
        find_first_instance_row = foundIt.Row
    Else
        'force bad value when not found this makes returned value easily testable
        find_first_instance_row = -1
    End If

    Set searchRange = Nothing
    Set foundIt = Nothing
End Function

以上假设 vba 插入的文本在用户输入姓名之前就已存在；如果出于某种原因不存在，则无法进行测试以确保用户没有在 2、3、10 行以下输入姓名。如果您想添加一个测试，可以修改 IF ELSE 使其看起来像这样：

If rowWithDefaultText = ENTRY_ROW_NOT_FOUND Then
    'user has overwitten that text in the cell that had the text prior

    'Secondary check added
    If Not entry_row_and_correct_row_match(USER_ENTRY_COL, 1, Target.Row) Then
        MsgBox "Do Something Here to handle this case"
    End If
Else
    'Alerts the user and clears what they entered into the wrong cell
    MsgBox "Please enter your information into row " & rowWithDefaultText, vbInformation, "Data Entered in Wrong Row"
    Target.Clear
    Cells(rowWithDefaultText, USER_ENTRY_COL).Activate

''        'Moves whatever the user entered, from the wrong cell into the right cell
''        Dim name As Variant
''        name = Target.Cells(1, 1).Value
''        Target.Clear
''        Cells(rowWithDefaultText, USER_ENTRY_COL).Value = name
End If

并添加以下2个函数来支持二次测试：

'//Checks the last populated cell in a continuous range moving
'//down the worksheet against the row number passed in 'entryRow'
'//to see if they are a match
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row at which to begin the search
'@PARAM entryRow - The row to test against
Private Function entry_row_and_correct_row_match(ByVal colNum As Integer, _
                ByVal startRow As Long, ByVal entryRow As Long) As Boolean
    Dim correctRow As Long
    correctRow = find_last_xlDown_row(colNum, 1)
    entry_row_and_correct_row_match = (entryRow = correctRow)
End Function

'//Finds the last populated cell going down a row, beginning on the
'//starting row number you provide.
'//ASSUME:Range is continuous in the targeted column!
'@PARAM colNum - The column number for the column to be searched
'@PARAM startRow - The row at which to begin the search
Public Function find_last_xlDown_row(ByVal colNum As Integer, _
                                        ByVal startRow As Long) As Long
    find_last_xlDown_row = Cells(startRow, colNum).End(xlDown).Row
End Function

顺便说一句，您可能需要考虑将 vba 插入的文本更改为“输入您的姓名这里“；添加这个词可能会减少您看到此问题的实例数。

注意：所有这些代码都可以进入工作表的代码页。

希望这有帮助，Nim

答案2

为什么不使用工作表保护和 VBA 一起吗？

  1. 选择要编辑的单元格或列

  2. 按CTRL+ 1» 转到标签保护» 取消选中锁定

  3. 菜单栏»工具»保护»保护工作表»确定（不输入密码）

    在此处输入图片描述

现在，每个打开工作簿的用户只能在选定的单元格或列中输入数据。如果您想允许用户在任何地方编辑后他已经输入了他的名字，你可以使用这个 VBA 代码

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Sheets(1).Cells(2, 1).Value <> "Enter your name" Then
        Sheets(1).Unprotect
    Else
        Sheets(1).Protect
    End If
End Sub

每次选择发生变化时（输入单元格数据会自动与选择变化相结合），代码都会检查单元格 A1 中的字符串“输入您的姓名”是否已发生改变。如果是，则保护将被禁用。

相关内容