條件鎖單元，無法排序

Question

我正在嘗試編寫一個宏，該宏將鎖定任何大於0的單元格。當我運行下面的代碼時，該宏有效，但鎖定了第一行，在該行中有一個下拉箭頭用於排序和數字過濾。 有沒有一種方法可以添加到此代碼中，以便第一行不會被鎖定？

Sub Test()
    Dim Cell As Range
    Dim MyPlage As Range

    With ThisWorkbook.ActiveSheet
        .Unprotect
        .Cells.Locked = False
        Set MyPlage = .Range("J2:AA1074")
        For Each Cell In MyPlage
            If Not IsError(Cell) Then
                If Cell.Value > "0" Then
                    Cell.Locked = True
                End If
            End If
        Next
        .Protect
    End With

End Sub

Answer 1

最簡單的是定義不包括“頂行”的范圍：）

更改

.Range("J2:AA1074")

至

.Range("J3:AA1074")

另外，您可以直接使用SpecialCells ，而無需遍歷范圍內的每個單元格並檢查該單元格是否有錯誤，而無需循環。 例如（ TRIED AND TESTED ）

Sub Sample()
    Dim Cell As Range, MyPlage As Range, FinalRange As Range

    With ThisWorkbook.ActiveSheet
        .Unprotect
        .Cells.Locked = False

        On Error Resume Next
        Set MyPlage = .Range("J3:AA1074").SpecialCells(xlCellTypeConstants)
        On Error GoTo 0

        If Not MyPlage Is Nothing Then
            For Each Cell In MyPlage
                If Cell.Value > 0 Then Cell.Locked = True
            Next
        End If

        .Protect DrawingObjects:=True, _
                 Contents:=True, _
                 Scenarios:=True, _
                 AllowFiltering:=True, _
                 AllowSorting:=True

        .EnableSelection = xlUnlockedCells
    End With
End Sub

為了確保自動篩選和排序工作，在其指定.Protect因為我在上面所做的。

在運行上面的代碼之前，您還需要采取額外的步驟。

1. 如果工作表已經受到保護，則取消保護它
2. 在“查看”選項卡下，單擊“允許用戶編輯范圍”
3. 添加“新”范圍
4. 選擇您要允許用戶排序​​的范圍

屏幕截圖

Answer 2

您可以將以下代碼添加到工作Sheet module （使用自動過濾Sheet module將Range("J1:AA1")更改為范圍）：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.Intersect(Target, Range("J1:AA1")) Is Nothing Then
        ActiveSheet.Protect
    Else
        ActiveSheet.Unprotect
    End If
End Sub