VBA的Excel – 行单元格使用条件格式locking/解锁？
嗨，我的工作表有103列和18550行数据来自数据库。 基于B列的单元格值，我必须应用相应的行的格式，如[如果B2值是1，那么该行的内部颜色应该是橙色的颜色，否则，如果它是-1，那么它应该在蓝色，否则，如果它是0那么F＆G列应该是绿色的，这些绿色的单元格不应该被locking。 每一个有价值的行和立即的-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" 我们可以做与条件格式相同的。 根据单元格值对行应用格式和locking/解锁。 任何帮助将不胜感激。
正如我提到的，你不能locking/解锁条件格式的单元格。 您将必须先应用条件格式，然后locking/解锁单元格。 你也不需要循环来应用条件格式。 你可以一口气做到这一点。
尝试这个
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
据我所知，locking和分组不能用条件格式来完成，然而着色却可以完成。
您可以在条件格式对话框中input基于单元格的公式颜色，并且此公式可以包含对其他单元格的相对，半相对和绝对引用（在任何其他公式中使用$表示法）。
例如，可以通过在单元格D2中将条件格式设置为formula =if($B1=1;TRUE;FALSE)来完成“如果列B = 1，则使行成为橙色”。 如果在本例中将$放在B的前面，则可以将条件格式应用于整个范围的列D：H，并且它应该像脚本那样对行进行着色。
做所有的颜色只是重复这个过程，并用不同的公式设置更多的条件格式规则。