EXCEL VBA用于锁定偏移单元格-1列为空白的范围内的单元格

Question

我需要一段 VBA 编码来帮助我完成一个项目。我对 VBA 的了解非常基础，所以我很挣扎。由于我已经阅读了类似的请求，但仍然未能完成代码，因此我提供了尽可能多的详细信息。

我有一系列“两列”（Pattern 和 Desks）(x7)，代表星期天 - 星期六一周的 7 天。每天的左栏代表轮班模式，每天的右栏代表分配给每个人的办公桌。有一些空白列，所以我正在使用名称范围。

移位模式列 x7 位于左侧，并定义为名为“模式”的范围。办公桌列位于每个班次列的右侧，并定义了一个名为 Desks 的范围。这些列大约有 25 个单元格。但这因工作簿而异。因此使用命名范围。

我想锁定名为“Desks”的命名范围中的每个单元格，其中未填充名称范围“Pattern”中左侧的单元格 -1 列。

工作表已被选中且未受保护，并且名为 Desks 的范围已解锁。

Sheets("Assign Desks").Select
    ActiveSheet.Unprotect
    Application.Goto Reference:="Desks"
    Selection.ClearContents
 'Unlock Cells
    Selection.Locked = False

在锁定单元格的代码之后，工作表受到保护，功能区隐藏，屏幕拆分以显示到工作表。这工作正常。

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

其他信息 Pattern 列包含一个公式，该公式在刷新数据（粘贴到工作簿的另一工作表）时显示模式。两列都包含条件格式，以便在填充后格式化单元格。

刷新后，用户需要为每个班次分配办公桌（这不能自动化，因为需要人工决策。）但是我希望用户能够从可用列表中选择需要分配办公桌的单元格剩余的可用办公桌。我希望单元格没有被跳过（因此被锁定）。 Part of worksheet

Answer 1

这样的东西能解决问题吗？我不喜欢尽可能使用命名范围。我在示例中看不到行/列，因此此方法尝试动态定义它们。它还会将锁定的单元格变为黄色，以便用户知道哪些单元格被锁定，但可以根据需要随意删除/更改它（显然）。

Option Explicit
Sub UnlockSomeCells()
Dim headerRow As Long, lastRow As Long, firstCol As Long, lastCol As Long
Dim x As Long, y As Long
Dim ws As Worksheet

'set the worksheet to work with
Set ws = ThisWorkbook.Sheets("Assign Desks")

'unlock sheet
ws.Unprotect

'define the row where the headers are located (change as necessary)
headerRow = 5

'determine the last column
lastCol = ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column

'determine firstcol
For y = 1 To lastCol
    If ws.Cells(headerRow, y).Value <> "" Then
        firstCol = y
        Exit For
    End If
Next y

'lock all cells by default
ws.Cells.Locked = True

'loop through columns
For y = firstCol To lastCol

    'if finding the start of a set, start
    If ws.Cells(headerRow, y) = "Shift Pattern" Then

        'define last row for set
        lastRow = WorksheetFunction.Max( _
        ws.Cells(ws.Rows.Count, y + 0).End(xlUp).Row, _
        ws.Cells(ws.Rows.Count, y + 1).End(xlUp).Row, _
        ws.Cells(ws.Rows.Count, y + 2).End(xlUp).Row)

        'clear middle col
        'With ws.Range(ws.Cells(headerRow + 1, y + 1), ws.Cells(lastRow, y + 1))
        '    .ClearContents
        '    .Interior.ColorIndex = xlNone
        'End With

        'find cells to unlock
        For x = headerRow + 1 To lastRow
            If ws.Cells(x, y) <> "" Then

                'unlock the cell
                ws.Cells(x, y + 1).Locked = False

                'show that the cells are UNlocked in some way for the user's benefit
                'ws.Cells(x, y + 1).Interior.Color = RGB(0, 255, 255)

            End If
        Next x

    End If

Next y

'lock sheet
ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

编辑：更改为默认锁定所有单元格，仅解锁 Shift Pattern 列中非空白条目右侧的单元格。