清理条件格式（Excel VBA）
我很抱歉，如果这已被回答，但我无法find它。 这是我想要的：我们都知道，删除范围，行和列将拆分条件格式，使其丑陋。 我想创build一个个人macros：
1.) Searches through all existing Conditional Formatting in the active sheet 2.) Recognizes duplicates based on their condition and format result 3.) Finds the leftmost column and highest row in all duplicates 4.) Finds the rightmost column and lowest row in all duplicates 5.) Determines a broadened Range using those four values 6.) Remembers the condition and format 7.) Deletes all duplicates 8.) Recreates the Conditional Format over the broadened Range 9.) Repeats until no more duplicates are found 10) Outputs how many duplicates were deleted in a MsgBox 我有50％的信心可以自己做，但我有一种感觉，我需要学习如何处理数组variables。 （其中我完全无知，因此害怕）所以如果有人已经创造了这个，那么我请求你分享你的天才。 或者，如果有人认为他们可以鞭打这一点，我给你提供了机会来创build什么可能成为整个个人macros观用户群体中最常用的工具之一（右上angular用Ctrl + Shift + V）。
或者，如果没有人或想要，那么也许一些提示？ 来吧，把我扔在这里！
这将删除复制和粘贴行时创build的重复条件格式设置规则集：
Option Explicit Public Sub resetConditionalFormatting() Const F_ROW As Long = 2 Dim ws As Worksheet, ur As Range, maxCol As Long, maxRow As Long, thisCol As Long Dim colRng As Range, fcCol As Range, fcCount As Long, fcAdr As String Set ws = ThisWorkbook.ActiveSheet Set ur = ws.UsedRange maxRow = ur.Rows.Count maxCol = ur.Columns.Count Application.ScreenUpdating = False For Each colRng In ws.Columns If colRng.Column > maxCol Then Exit For thisCol = thisCol + 1 Set fcCol = ws.Range(ws.Cells(F_ROW, thisCol), ws.Cells(maxRow, thisCol)) With colRng.FormatConditions If .Count > 0 Then fcCount = 1 fcAdr = .Item(fcCount).AppliesTo.Address While fcCount <= .Count If .Item(fcCount).AppliesTo.Address = fcAdr Then .Item(fcCount).ModifyAppliesToRange fcCol fcCount = fcCount + 1 Else .Item(fcCount).Delete End If Wend End If End With Next Application.ScreenUpdating = True End Sub
。
在高层次：
- 它遍历活动工作表使用范围的每一列
- 根据地址组确定重复项
-
如果它发现多个集合：
- 对于第一组 – 它将AppliesTo范围更新为（firstRow：lastRow）
- 删除所有其他集
（在.Delete语句之后可以添加一个复制的计数器）
testing文件
初始规则：
复制并粘贴最后2行后，两次：
清理完成后：
笔记：
- 有14种不同types的规则，许多属性是不同的
- 并非所有types都有.Formula或.Formula1，甚至是相同的格式属性
- types可以在testing文件或微软页面中看到
这是一个尽可能通用的不完整的尝试（仅作为一个起点）
Option Explicit Private Const SP As String = "||" 'string delimiter, or SeParator Public Sub x() resetConditionalFormatting Sheet1.UsedRange End Sub
Public Sub resetConditionalFormatting(Optional ByRef rng As Range = Nothing) Const FIRST_ROW As Long = 2 Dim colRng As Range, thisCol As Long, fc As FormatCondition, thisFC As Long Dim maxCell As Range, ws As Worksheet, cell1 As Range, cell2 As Range If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange Set ws = rng.Parent Set maxCell = GetMaxCell(rng) If maxCell.Row > 1 Or maxCell.Column > 1 Or Len(maxCell) > 0 Then thisCol = 1 Set cell1 = ws.Cells(FIRST_ROW, thisCol) Set cell2 = ws.Cells(maxCell.Row, thisCol) For Each colRng In rng.Columns thisFC = 1 For Each fc In colRng.FormatConditions fc.ModifyAppliesToRange ws.Range(cell1, cell2) thisFC = thisFC + 1 Next thisCol = thisCol + 1 Next End If End Sub
Private Sub fcDupe(ByRef fc As Variant, ByRef fcType() As String, ByRef dupes As Long) Dim tStr As String, itm As Variant, fcT As Byte On Error Resume Next 'some properties may not be defined at runtime With fc fcT = .Type tStr = SP 'Border, Font, and Interior apply to 1, 2, 5, 8, 9, 10, 11, 12, 13, 16, 17 tStr = tStr & CStr(ObjPtr(.Borders)) & _ CStr(ObjPtr(.Font)) & _ CStr(ObjPtr(.Interior)) 'CStr(ObjPtr(fc)): https://support2.microsoft.com/default.aspx?scid=kb;en-us;199824 Select Case fcT Case xlCellValue '1 tStr = tStr & .DateOperator tStr = tStr & .Formula1 tStr = tStr & .Formula2 tStr = tStr & .Operator tStr = tStr & .ScopeType tStr = tStr & .Text tStr = tStr & .TextOperator tStr = tStr & SP Case xlColorScale '3 tStr = SP & CStr(ObjPtr(.ColorScaleCriteria)) tStr = tStr & .Formula tStr = tStr & .ScopeType tStr = tStr & SP Case xlDatabar '4 tStr = SP & CStr(ObjPtr(.AxisColor)) & _ CStr(ObjPtr(.BarBorder)) & _ CStr(ObjPtr(.BarColor)) & _ CStr(ObjPtr(.MaxPoint)) & _ CStr(ObjPtr(.MinPoint)) & _ CStr(ObjPtr(.NegativeBarFormat)) tStr = tStr & .AxisPosition tStr = tStr & .BarFillType tStr = tStr & .Direction tStr = tStr & .Formula tStr = tStr & .PercentMax tStr = tStr & .PercentMin tStr = tStr & .ScopeType tStr = tStr & .ShowValue tStr = tStr & SP Case xlTop10 '5 tStr = tStr & .CalcFor tStr = tStr & .Percent tStr = tStr & .Rank tStr = tStr & .TopBottom tStr = tStr & .ScopeType tStr = tStr & SP Case 6 'XlFormatConditionType.xlIconSet tStr = SP & CStr(ObjPtr(.IconCriteria)) & CStr(ObjPtr(.IconSet)) tStr = tStr & .Formula tStr = tStr & .PercentValue tStr = tStr & .ReverseOrder tStr = tStr & .ScopeType tStr = tStr & .ShowIconOnly tStr = tStr & SP Case xlUniqueValues '8 tStr = tStr & .DupeUnique tStr = tStr & .ScopeType tStr = tStr & SP Case xlTextString '9 tStr = tStr & .DateOperator tStr = tStr & .Formula1 tStr = tStr & .Formula2 tStr = tStr & .Operator tStr = tStr & .ScopeType tStr = tStr & .Text tStr = tStr & .TextOperator tStr = tStr & SP Case xlAboveAverageCondition '12 tStr = tStr & .AboveBelow tStr = tStr & .CalcFor tStr = tStr & .Formula1 tStr = tStr & .Formula2 tStr = tStr & .NumStdDev tStr = tStr & SP Case xlExpression, _ xlBlanksCondition, _ xlTimePeriod, _ xlNoBlanksCondition, _ xlErrorsCondition, _ xlNoErrorsCondition tStr = tStr & .Formula1 tStr = tStr & .Formula2 tStr = tStr & SP End Select If InStr(1, fcType(fcT), tStr, vbBinaryCompare) = 0 Then fcType(fcT) = fcType(fcT) & tStr Else .Delete dupes = dupes + 1 End If End With End Sub
Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range 'It returns the last cell of range with data, or A1 if Worksheet is empty Const NONEMPTY As String = "*" Dim lRow As Range, lCol As Range If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange If WorksheetFunction.CountA(rng) = 0 Then Set GetMaxCell = rng.Parent.Cells(1, 1) Else With rng Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _ After:=.Cells(1, 1), _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows) Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _ After:=.Cells(1, 1), _ SearchDirection:=xlPrevious, _ SearchOrder:=xlByColumns) Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column) End With End If End Function
查看特定格式条件的所有属性的方法：
