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

Question

---

嗨，我的工作表有103列和18550行数据来自数据库。根据 B 列单元格值，我必须为相应的行应用格式，如[ B2 值为1，那么对于该行，内部颜色应为橙色，否则如果它是-1然后它应该是蓝色其他如果它是0然后列 F＆amp; 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"

---

我们可以使用条件格式执行相同的操作。应用格式＆amp;根据单元格值锁定/解锁行。非常感谢任何帮助。

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

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

您可以根据条件格式对话框中输入的公式为单元格着色，此公式可以包含对其他单元格的相对，半相对和绝对引用（使用$符号，如同在任何其他公式中一样）。

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

执行所有颜色只是重复该过程并使用不同的公式设置更多条件格式规则。