使用条件格式的行单元格锁定/解锁?

---

Hi, my sheet has 103 columns and 18550 rows of data which is coming from database. Based on B column cells value i have to apply formatting for the respective row like [if B2 value is 1 then for that row interior color should be Orange in color else if it is -1 then it should be in Blue else if it is 0 then the columns F & G should be Green in color and these green coloured cells should not be locked. And every 1 valued row and the immediate -1 valued rows should be grouped. Currently i have the following code which is almost taking 8 minutes of time to apply formattings.

你好，我的表格有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"

---

Can we do the same with Conditional Formatting. Applying format & locking/unlocking for the rows based on cell value. Any help would be appreciated greatly.

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

2 个解决方案

#1

As i mentioned that you cannot lock/unlock a cell in conditional formatting. You will have to first apply the conditional formatting and then lock/unlock the cells. Also you do not need to loop to apply conditional formatting. You can do that in one go.

正如我提到的，您不能在条件格式中锁定/解锁单元格。您必须首先应用条件格式，然后锁定/解锁单元格。同样，您不需要循环来应用条件格式。你可以一口气做完。

Try this

试试这个

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

ScreenShot

截图

EDIT

编辑

For 103 Columns and 18550 Rows use this method. This is much faster than the above

对于103列和18550行使用此方法。这比上面的快多了。

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

#2

As far as I know, the locking and grouping cannot be done with Conditional Formatting, the coloring however can be done.

据我所知，锁定和分组不能用条件格式完成，但是着色是可以完成的。

You can color a cell based o a formula entered in conditional formatting dialog and this formula can contain relative, semi-relative and absolute references to other cells (using the $ notation as in any other formulas).

您可以根据条件格式对话框中输入的公式为单元格着色，该公式可以包含对其他单元格的相对、半相对和绝对引用(与其他公式一样使用$ notation)。

For example the "make row orange if column B = 1" can be done by setting condition formatting in cell D2 to formula =if($B1=1;TRUE;FALSE). If you put the $ in front of B as in this example, than you can apply the conditional formatting to the whole range columns D:H and it should color the lines as your script does.

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

Doing all the colors is just repeating the process and setting more conditional formating rules with different formulas.

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