[英]VBA Excel - Row cells locking/unlocking using Conditional formatting?
嗨,我的工作表有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"
我們可以對條件格式進行同樣的處理嗎? 根據單元格值為行應用格式和鎖定/解鎖。 任何幫助將不勝感激。
正如我提到的那樣,您不能以條件格式鎖定/解鎖單元格。 您將必須首先應用條件格式,然后鎖定/解鎖單元格。 另外,您無需循環即可應用條件格式。 您可以一口氣做到這一點。
嘗試這個
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
據我所知,鎖定和分組不能使用條件格式進行,但是可以進行着色。
您可以為在條件格式對話框中輸入的基於單元格的公式着色,並且該公式可以包含對其他單元格的相對,半相對和絕對引用(與其他任何公式一樣,都使用$表示法)。
例如,可以通過將單元格D2中的條件格式設置為公式=if($B1=1;TRUE;FALSE)
來完成“如果列B = 1,則使行變為橙色”。 如果在本例中將$放在B的前面,則可以將條件格式應用於整個范圍列D:H,它應該像腳本一樣對行進行着色。
完成所有顏色只是重復該過程,並使用不同的公式設置更多的條件格式設置規則。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.