如果第2行包含第1行，则复制第2行

Question

我有大型电子表格，我希望只保留唯一的行值并删除冗余数据。这将为我提供行的独特组合，我必须使用它创建DFD

输入：

R1 1, 1, 1, 1, 1

R2 1, 1, 1, 1, 1, 2

R3 1, 1, 1, 1, 1, 2, 3

R4 1, 1, 1

R5 1, 2, 1, 1, 1, 1

R6 1, 2, 1, 1, 1, 1, 3

R7 1, 2, 1

R8 1, 2, 3, 4, 1, 1

R9 1, 2, 3, 1, 1, 1

输出：

R3 1, 1, 1, 1, 1, 2, 3

R6 1, 2, 1, 1, 1, 1, 3

R8 1, 2, 3, 4, 1, 1

R9 1, 2, 3, 1, 1, 1

代码：

编写的代码是一种浪费..它只是在数组中添加了列值。

Answer 1

有趣的逻辑问题。

^的前的

Sub recursive_RemoveDuplicates()
    Dim rw As Long, cl As Long, sCI As String

    With Worksheets("Sheet1")
        With .Cells(1, 1).CurrentRegion

            For cl = 0 To .Columns.Count - 1 Step 3
                Select Case (.Columns.Count - cl)
                    Case Is > 2
                        .Cells.Sort Key1:=.Columns(cl + 3), Order1:=xlDescending, _
                                    Key2:=.Columns(cl + 2), Order2:=xlDescending, _
                                    Key3:=.Columns(cl + 1), Order3:=xlDescending, _
                                    Orientation:=xlTopToBottom, Header:=xlNo
                    Case Is > 1
                        .Cells.Sort Key1:=.Columns(cl + 2), Order1:=xlDescending, _
                                    Key2:=.Columns(cl + 1), Order2:=xlDescending, _
                                    Orientation:=xlTopToBottom, Header:=xlNo
                    Case Else
                        .Cells.Sort Key1:=.Columns(cl + 1), Order1:=xlDescending, _
                                    Orientation:=xlTopToBottom, Header:=xlNo
                End Select
            Next cl

            For rw = .Rows.Count To 2 Step -1
                sCI = "COUNTIFS("
                For cl = 1 To .Cells(rw, Columns.Count).End(xlToLeft).Column
                    sCI = sCI & .Cells(1, cl).Resize(rw - 1, 1).Address(0, 0) & Chr(44) & _
                            .Cells(rw, cl).Value & Chr(44)
                Next cl
                sCI = Left(sCI, Len(sCI) - 1) & ")"
                If CBool(Application.Evaluate(sCI)) Then _
                    .Rows(rw).EntireRow.Delete
            Next rw

        End With
    End With
End Sub

我有一段时间没问题，直到我使用原生工作表功能作弊。

^后的