<em>EXCEL</em> <em>VBA</em>删除相同内容列-e

工具/原材料

EXCEL2016、电脑抄。

1、打开电脑找到并点击EXCEL2016版的软件；

2、打开EXCEL软件以后，为了更好的示范，先在文档内新建并选中有重复项的内容；

3、选中需要删除重复的内容以后，在点击上方工袭具栏的“数据”命令；

4、选择数据命令以后，在下方“点百击删除重复项”；

5、点击以后，在弹出的对话框中点击“全选”和“删除重复项”；

6、选择并确度定好以后，表格上重复的内容已被成功删除，并且保留一项。

Sub s()
    n = Cells(Rows.Count, 11).End(3).Row
    k = Cells(n, Columns.Count).End(1).Column
    For i = 11 To k - 1
        j = i + 1
        Do While j <= k
            For x = 13 To n
                If Cells(x, i) <> Cells(x, j) Then
                    GoTo xxx
                End If
            Next
            Columns(j).Delete
            k = k - 1
            j = j - 1
xxx:
            j = j + 1
        Loop
    Next
End Sub

Sub xx()
  Set d1 = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  With [AF666:AO866]
    .Interior.ColorIndex = xlNone
    For i = 1 To .Count
      d1(.Item(i).Text) = ""
    Next
  End With
  With [A39:J1038]
    For i = 1 To .Count
      If d1.exists(.Item(i).Text) Then
        d2(.Item(i).Text) = ""
        .Item(i).ClearContents
      End If
    Next
  End With
  With [AF666:AO866]
    For i = 1 To .Count
      If d2.exists(.Item(i).Text) Then
        .Item(i).Interior.ColorIndex = 7
      End If
    Next
  End With
End Sub

Sub keep3()
Dim m!, n!, t$, Exist As Boolean, i As Range, j As Range, r As Range, rj As Range, a
t = "C5:H20"
For Each j In Range(t).Columns
    Set rj = Intersect(j, Range(t))
    ReDim a(rj.Count - 1)
    n = 0
    For Each i In rj
        If WorksheetFunction.CountIf(rj, i) >= 3 Then
            Exist = False
            For m = 0 To UBound(a) - 1
                If a(m) = i Then Exist = True: Exit For
            Next
            If Not Exist Then
            a(n) = i.Value
            n = n + 1
            End If
        End If
    Next
    rj.ClearContents
    rj(1).Resize(UBound(a) - 1) = WorksheetFunction.Transpose(a)
Next
End Sub

附件请下载参考e79fa5e98193e58685e5aeb9333

本文标签：vba删除空excel(2)excel vba 删除重复(1)