Excel中删除两列中重复的数据[原创]

宏代码如下 ：

Sub DelTheSame()
    Dim MyColCompare
InPutCel:
    MyColCompare = Application.InputBox(Prompt:="请输入需要对比的两列，用英文逗号隔开（,）！" & vbCrLf & vbCrLf & "例如：A,C", Default:="A,B", Title:="请输入需要对比的列", Type:=2 + 4)
    If MyColCompare = False Then Exit Sub Else MyColCompare = Replace(MyColCompare, " ", "")
    Dim SubCel() As String
    SubCel() = Split(MyColCompare, ",")
    If UBound(SubCel()) <> 1 Or Replace(MyColCompare, ",", "") = "" Then MsgBox "请输入两个列号，用英文逗号隔开，如：A,C", vbOKOnly + vbExclamation, "提示！": GoTo InPutCel
    If Len(SubCel(0)) <> 1 Or Len(SubCel(1)) <> 1 Then MsgBox "本程序只能对比 A-Z 之间的列，请重新输入，如：A,C", vbOKOnly + vbExclamation, "提示！": GoTo InPutCel
    If Not ((Asc(SubCel(0)) >= 65 And Asc(SubCel(0)) <= 90) Or (Asc(SubCel(0)) >= 97 And Asc(SubCel(0)) <= 122)) Or Not ((Asc(SubCel(1)) >= 65 And Asc(SubCel(1)) <= 90) Or (Asc(SubCel(1)) >= 97 And Asc(SubCel(1)) <= 122)) Then
        MsgBox "本程序只能处理A-Z之间的列，请重新输入，如：A,C", vbOKOnly + vbExclamation, "提示！"
        GoTo InPutCel
    End If
BeginCheck:
    Range(SubCel(0) & 1).Select
    For i = 1 To ActiveSheet.Range(SubCel(0) & "65535").End(xlUp).Row
        Range(SubCel(0) & i).Select
        For j = 1 To ActiveSheet.Range(SubCel(1) & "65535").End(xlUp).Row
            If Range(SubCel(0) & i).Value = Range(SubCel(1) & j).Value And (Range(SubCel(0) & i).Value <> "" Or Range(SubCel(1) & j).Value <> "") Then
                Range(SubCel(0) & i).Delete shift:=xlUp
                Range(SubCel(1) & j).Delete shift:=xlUp
                GoTo BeginCheck
            'Else
            '    Range(SubCel(0) & i).Interior.Color = RGB(200, 160, 35)
            End If
        Next j
    Next i
End Sub