看图excel重复数据如何批量删除只保留一个

Sub 单元格提取不重复其个数()
   '2010-6-27 17:40
   Dim myrange As Range, myrange1 As Range, zhtj(), i As Long, i1 As Long, j As Long
   Set myrange1 = Application.InputBox(Prompt:="使用鼠标选择提取数据单元格区域", Type:=8)
   ReDim zhtj(myrange1.Count, 2)
   i = 0
   For Each myrange In myrange1
       If myrange.Value <> "" Then
            i = i + 1
            If i = 1 Then
               zhtj(i, 1) = myrange.Value
            Else
               i1 = i
               For j = 1 To i - 1
                  If zhtj(j, 1) = myrange.Value Then i = i - 1: Exit For
               Next j
               If i1 = i Then
                 zhtj(i, 1) = myrange.Value
               End If
            End If
         End If
    Next myrange
      For j = 1 To i
         zhtj(j, 2) = Application.WorksheetFunction.CountIf(myrange1, zhtj(j, 1))
      Next j
      Set myrange1 = Application.InputBox(Prompt:="使用鼠标选择提取数据输出单元格", Type:=8)
      Range(myrange1, myrange1.Offset(i - 1, 1)) = zhtj
End Sub

用上面代码可以达到相似的结果，下面是例：

操作方法

用代码的字典呗。只是一行才可以用筛选的去重。

选中区域，删除重复项。