Question

如果已经回答这个问题，我很抱歉，但我无法找到它。这就是我想要的：我们都知道删除范围，行和列将拆分条件格式并使其变得可怕。我想创建一个个人宏：

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％的自信我可以自己做，但我有一种感觉，我需要学习如何使用数组变量。（其中我完全无知，因此害怕）所以如果有人已经创造了这个，那么我求你你分享你的天才。或者，如果有人认为他们可以解决这个问题，我建议您有机会创建一个可能成为整个个人宏用户群中最常用的最常用的工具之一（在那里使用Ctrl + Shift键+ V）。

或者，如果没有人或想要，那么也许一些提示???来吧，在这里扔我一块骨头！

Answer 1

这将删除复制和粘贴行时创建的重复条件格式设置规则集：

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语句之后添加重复的计数器）

测试文件

初始规则：

Initial rules

复制并粘贴最后两行后，两次：

After copying and pasting the last 2 rows twice

清理后：

enter image description here

注意：

有14种不同类型的规则，许多属性不同
并非所有类型都有.Formula或.Formula1，甚至是相同的格式属性
可以在测试文件或this Microsoft page

Answer 2

这是我对这个问题的回答。我只为使用公式的条件格式实现了它，因为我很少使用其他条件格式类型。也可以从我的个人网站MergeConditionalFormatting v1.0

中作为外接程序使用。

这是代码：

select * ,ROW_NUMBER () OVER (PARTITION BY rut ORDER BY created_at ASC) AS ranking  
from (
SELECT DISTINCT (concat(rut,created_at)),*
FROM table 
WHERE DATE(created_at) <= "2020-12-03" 
) tt
order by rut,ranking

Answer 3

这是一个不完整的尝试，使其尽可能通用（仅作为起点提供）

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

查看特定格式条件的所有属性的方法：

清理条件格式（Excel VBA）

3 个答案: