Question

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

我有一系列的“两列”（模式和书桌）（x7）代表星期日 - 星期六的七天。每天的左栏代表班次模式，每天的右栏代表分配给每个人的书桌。有一些空白列，所以我正在使用名称范围。

换档模式列x7位于左侧，并定义为名为“Pattern”的范围。桌面列位于每个移位列的右侧，并定义了一个名为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模式列中非空白条目右侧的单元格。

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

1 个答案: