excel vba判断所选范围列是否重复与不重复二种代码

代码1范围。K列.end(3).row-14：bm列.end(3).row-11判断所选范围列是否重复（删除重复）
代码2范围。K列.end(3).row-15：bm列.end(3).row-11判断所选范围列是否不重复（删除不重复）
代码3：K列.end(3).row-15：bm列.end(3).row-11

Sub 删除不重复()
    Dim arr, i&, j&, n&
    Dim d, k, t, x
    For i = 11 To 65
    Set d = CreateObject("Scripting.Dictionary")
    n = Cells(65536, i).End(3).Row
    If n > 15 Then
        arr = Cells(n - 15, i).Resize(5)
        For j = 1 To 5
            If arr(j, 1) <> "" Then d(arr(j, 1)) = d(arr(j, 1)) & j & ","
        Next
        x = d.keys: t = d.items
        For j = 0 To UBound(x)
        t(j) = Left(t(j), Len(t(j)) - 1)
        If InStr(t(j), ",") = 0 Then
            Cells(CInt(t(j)) + n - 16, i).Clear
        End If
        Next
    End If
    Set d = Nothing
    Next
End Sub

Sub 删除重复()
    Dim arr, i&, j&, n&
    Dim d, k, t, x
    For i = 11 To 65
    Set d = CreateObject("Scripting.Dictionary")
    n = Cells(65536, i).End(3).Row
    If n > 15 Then
        arr = Cells(n - 15, i).Resize(5)
        For j = 1 To 5
            If arr(j, 1) <> "" Then d(arr(j, 1)) = d(arr(j, 1)) & j & ","
        Next
        x = d.keys: t = d.items
        For j = 0 To UBound(x)
        t(j) = Left(t(j), Len(t(j)) - 1)
        If InStr(t(j), ",") Then
            aa = Split(t(j), ",")
            For k = 0 To UBound(aa)
            Cells(aa(k) + n - 16, i).Clear
            Next
        End If
        Next
    End If
    Set d = Nothing
    Next
End Sub

Sub 重复保留1()
    Dim arr, i&, j&, n&
    Dim d, k, t, x
    For i = 11 To 65
    Set d = CreateObject("Scripting.Dictionary")
    n = Cells(65536, i).End(3).Row
    If n > 15 Then
        arr = Cells(n - 15, i).Resize(5)
        For j = 1 To 5
            If arr(j, 1) <> "" Then d(arr(j, 1)) = d(arr(j, 1)) & j & ","
        Next
        x = d.keys: t = d.items
        For j = 0 To UBound(x)
        t(j) = Left(t(j), Len(t(j)) - 1)
        If InStr(t(j), ",") Then
            aa = Split(t(j), ",")
            For k = 0 To UBound(aa) - 1
            Cells(aa(k) + n - 16, i).Clear
            Next
        Else
            Cells(CInt(t(j)) + n - 16, i).Clear
        End If
        Next
    End If
    Set d = Nothing
    Next
End Sub

温馨提示：内容为网友见解，仅供参考

当前网址：https://22.t2y.org/zz/i2xtchctshxhcsc2x2.html