VBA每一行分解再组合最后去除相同项

laoau138

VBA每一行分解再组合最后去除相同项

fongcai2008

看看

laoau138

fongcai2008 发表于 2016-9-30 14:30
看看

果然是高手


Sub Combine()
Application.ScreenUpdating = False
With Sheet1
    If .Range("I9999").End(xlUp).Row > 11 Then .Range(.Cells(11, 9), .Cells(.Range("i99999").End(xlUp).Row, 12)).ClearContents
    n = 11
    For i = 11 To .Range("A9999").End(xlUp).Row
        For j1 = 1 To 3
            For j2 = j1 + 1 To 4
                For j3 = j2 + 1 To 5
                    For j4 = j3 + 1 To 6
                        .Cells(n, 9) = .Cells(i, j1)
                        .Cells(n, 10) = .Cells(i, j2)
                        .Cells(n, 11) = .Cells(i, j3)
                        .Cells(n, 12) = .Cells(i, j4)
                        n = n + 1
                    Next
                Next
            Next
        Next
    Next
End With
Application.ScreenUpdating = True
End Sub

Sub Del_Same()
Application.ScreenUpdating = False
With Sheet1
    If .Range("N9999").End(xlUp).Row > 11 Then .Range(.Cells(11, 14), .Cells(.Range("N99999").End(xlUp).Row, 17)).ClearContents

    .Range(.Cells(11, 14), .Cells(11, 17)).Value = .Range(.Cells(11, 9), .Cells(11, 12)).Value

    n = 12
    For i = 12 To .Range("I99999").End(xlUp).Row
        m = 0
        For j = 11 To n
            If (.Cells(j, 14) = .Cells(i, 9)) And (.Cells(j, 15) = .Cells(i, 10)) And (.Cells(j, 16) = .Cells(i, 11)) And (.Cells(j, 17) = .Cells(i, 12)) Then m = 1
        Next
        If m = 0 Then
            .Range(.Cells(n, 14), .Cells(n, 17)).Value = .Range(.Cells(i, 9), .Cells(i, 12)).Value
            n = n + 1
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

laoau138

fongcai2008 发表于 2016-9-30 14:30
看看

高手，再来做一条

http://www.excelpx.com/thread-424709-1-1.html