EXCEL VBA用於鎖定偏移單元格-1範圍內的單元格列空白

Question

我需要一塊VBA編碼來幫助完成一個項目。我的VBA知識非常基礎，所以我很掙扎。我儘可能地提供了更多的細節，因爲我已經閱讀了類似的請求，但仍未能完成代碼。

我有一系列的「兩列」（模式和書桌）（x7），代表星期六至星期六的七天。每天的左欄代表班次模式，每天的右欄代表分配給每個人的桌面。有一些空白列，所以我正在處理名稱範圍。

換檔模式列x7位於左側，定義爲名爲「模式」的範圍。辦公桌欄位於​​每個移動欄的右側，並被定義爲一個名爲「辦公桌」的範圍。列是大約25個單元格。但是，這從工作簿到工作簿有所不同。因此使用命名範圍。

我想鎖定名爲「書桌」的名稱範圍內的每個單元格，其中名稱範圍「模式」中留下的單元格-1列未填充。

該工作表已被選中和未受保護，並且名爲書桌的範圍已解鎖。

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 

編輯：改變，使默認是禁用的所有細胞，只能解鎖是在換擋模式列非空條目右側細胞。