VBA Excel - 使用条件格式锁定/解锁行单元格？

Question

---

嗨，我的工作表有 103 列和 18550 行来自数据库的数据。基于 B 列单元格的值，我必须为相应的行应用格式，例如 [如果 B2 值为 1，则该行的内部颜色应为橙色，否则为为 -1 则应为蓝色，否则为 0 则列 F & G 应为绿色，并且不应锁定这些绿色单元格。并且每个 1 值行和立即 -1 值行都应该分组。目前我有以下代码几乎需要 8 分钟的时间来应用格式。

---

With ThisWorkBook.Sheets("RoAe").Range("A1:A" & rowLen)

'=================For 1 valued Rows==========
Set C = .Find("1", LookIn:=xlValues)
x=0
If Not C Is Nothing Then
    firstAddress = C.Address
    Do
            valR = Split(C.Address, "$")
            actVal = valR(2)
            ReDim Preserve HArray(x)
            HArray(x) = actVal + 1
            x = x + 1


            With ThisWorkBook.Sheets("RoAe").Range("D" & actVal & ":FN" & actVal)
                .Rows.AutoFit
                .WrapText = True
                .Font.Bold = True
                .Interior.Color = RGB(252,213,180) 
                .Borders.Color = RGB(0, 0, 0)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With

            Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> firstAddress
End If


'=================For -1 valued Rows==========
Set C = .Find("-1", LookIn:=xlValues)
y=0
If Not C Is Nothing Then
    firstAddress = C.Address
    Do
            valR = Split(C.Address, "$")
            actVal = valR(2)
            ReDim Preserve HArray(y)
            FArray(y) = actVal + 1
            y = y + 1


            With ThisWorkBook.Sheets("RoAe").Range("D" & actVal & ":FN" & actVal)
                .Rows.AutoFit
                .WrapText = True
                .Font.Bold = True
                .Interior.Color = RGB(141,180,226) 
                .Borders.Color = RGB(0, 0, 0)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With

            Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> firstAddress
End If


'===================For 0(Zero) Valued Rows============
For p = 0 To UBound(HArray)
    groupRange = "A" & HArray(p) & ":A" & FArray(p)     
    For i = 0 To UBound(arrUnlockMonthStart)
        unlockRange = F & (HArray(p) + 1) & ":" & G & FArray(p)                                                      
        ThisWorkBook.Sheets("RoAe").Range(unlockRange).Locked = False
        ThisWorkBook.Sheets("RoAe").Range(unlockRange).Interior.Color = RGB(216,228,188)
    Next
next

end with
ThisWorkBook.Sheets("RoAe").protect "12345"

---

我们可以对条件格式做同样的事情吗？根据单元格值对行应用格式和锁定/解锁。任何帮助将不胜感激。

Answer 1

正如我提到的，您不能以条件格式锁定/解锁单元格。您必须首先应用条件格式，然后锁定/解锁单元格。此外，您不需要循环应用条件格式。您可以一次性完成。

试试这个

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim Rng As Range, unlockRng As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        '~~> Set your range where CF will be applied for -1/1
        Set Rng = .Range("D2:H" & lRow)

        With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=1"
            .FormatConditions(1).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.399945066682943 '<~~ Orange
            End With
            .FormatConditions(1).StopIfTrue = True

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=-1"
            .FormatConditions(2).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599993896298105 '<~~ Blue
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Set your range where CF will be applied for 0
         Set Rng = .Range("F2:G" & lRow)

         With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=0"
            .FormatConditions(3).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.399975585192419 '<~~ Green
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Loop through cells in Col B to checl for 0 and store
         '~~> relevant Col F and G in a range
         For i = 2 To lRow
            If .Range("B" & i).Value = 0 Then
                If unlockRng Is Nothing Then
                    Set unlockRng = .Range("F" & i & ":G" & i)
                Else
                    Set unlockRng = Union(unlockRng, .Range("F" & i & ":G" & i))
                End If
            End If
         Next i
    End With

    '~~> unlock the range in one go
    If Not unlockRng Is Nothing Then unlockRng.Locked = False
End Sub

屏幕截图

编辑

对于103 Columns 和18550 Rows 使用此方法。这比上面的要快很多

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim Rng As Range, unlockRng As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Application.ScreenUpdating = False

    With ws
        '~~> Find the last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        '~~> Set your range where CF will be applied for -1/1
        '~~> Taking 103 Columns into account
        Set Rng = .Range("D2:DB" & lRow)

        With Rng
            .Locked = True

            .FormatConditions.Delete

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=1"
            .FormatConditions(1).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.399945066682943 '<~~ Orange
            End With
            .FormatConditions(1).StopIfTrue = True

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=-1"
            .FormatConditions(2).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599993896298105 '<~~ Blue
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Set your range where CF will be applied for 0
         Set Rng = .Range("F2:G" & lRow)

         With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=0"
            .FormatConditions(3).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.399975585192419 '<~~ Green
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Loop through cells in Col B to check for 0 and 
         '~~> unlock the relevant range
         For i = 2 To lRow
            If .Range("B" & i).Value = 0 Then
                .Range("F" & i & ":G" & i).Locked = False
            End If
         Next i
    End With

    Application.ScreenUpdating = True
End Sub

Answer 2

据我所知，条件格式无法进行锁定和分组，但是可以进行着色。

您可以根据在条件格式对话框中输入的公式为单元格着色，并且该公式可以包含对其他单元格的相对、半相对和绝对引用（在任何其他公式中使用 $ 表示法）。

例如，“如果列 B = 1，则使行变为橙色”可以通过将单元格 D2 中的条件格式设置为公式 =if($B1=1;TRUE;FALSE) 来完成。如果像本例那样将 $ 放在 B 前面，则可以将条件格式应用于整个范围列 D:H，并且它应该像脚本一样为行着色。

做所有的颜色只是重复这个过程，并用不同的公式设置更多的条件格式规则。