删除Excel个格式条件
Delete Excel individual format condition
我有一本带有条件格式的旧工作簿,在随机条件格式演变方面已经失控。我想遍历 sheet 并删除所有仅引用一个单元格的条件格式(但在同一单元格中保留其他格式,当然还保留单元格值等)
我将代码写在一个单独的 sheet 中,以便 (1) 我可以重复使用它 (2) 工作簿本身不需要宏
到目前为止,我可以识别单元格,但不能删除格式。我的代码是:
Option Explicit
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For Each fc In rCell.FormatConditions
'Determine if the FormatCondition only applies to one cell
If fc.AppliesTo.Cells.Count = 1 Then
Debug.Print fc.AppliesTo.Address
'I have tried fc.Delete
'I have tried fc.AppliesTo.Delete
End If
Next fc
Next rCell
End Sub
当我返回 sheet 时,我可以看到格式仍然存在。
从项目集合中删除时,如果您向后工作,有时效果会更好:
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook, i As Long
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For i = rCell.FormatConditions.Count To 1 Step -1
With rCell.FormatConditions(i)
If .AppliesTo.Cells.Count = 1 Then
Debug.Print .AppliesTo.Address
.Delete
End If
End With
Next i
Next rCell
End Sub
我有一本带有条件格式的旧工作簿,在随机条件格式演变方面已经失控。我想遍历 sheet 并删除所有仅引用一个单元格的条件格式(但在同一单元格中保留其他格式,当然还保留单元格值等)
我将代码写在一个单独的 sheet 中,以便 (1) 我可以重复使用它 (2) 工作簿本身不需要宏
到目前为止,我可以识别单元格,但不能删除格式。我的代码是:
Option Explicit
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For Each fc In rCell.FormatConditions
'Determine if the FormatCondition only applies to one cell
If fc.AppliesTo.Cells.Count = 1 Then
Debug.Print fc.AppliesTo.Address
'I have tried fc.Delete
'I have tried fc.AppliesTo.Delete
End If
Next fc
Next rCell
End Sub
当我返回 sheet 时,我可以看到格式仍然存在。
从项目集合中删除时,如果您向后工作,有时效果会更好:
Sub Delete_Conditional()
Dim fc As FormatCondition
Dim lLastRow As Long, lLastCol As Long
Dim rAllCells As Range, rCell As Range
Dim ws As Worksheet
Dim wb As Workbook, i As Long
Set wb = Workbooks("Book1.xlsx")
Set ws = wb.Worksheets("Sheet1")
'Find last cell and set a range to cover all cells
lLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
lLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rAllCells = Range(Cells(1, 1), Cells(lLastRow, lLastCol))
'Loop through all cells
For Each rCell In rAllCells.Cells
'Loop through all FormatConditions in the cell
For i = rCell.FormatConditions.Count To 1 Step -1
With rCell.FormatConditions(i)
If .AppliesTo.Cells.Count = 1 Then
Debug.Print .AppliesTo.Address
.Delete
End If
End With
Next i
Next rCell
End Sub