如何删除单元格中的重复项？

zmdly

例如：

可见单元格中有重复的数据，我希望把重复的删除掉，可是在遇到大量数据时如何比较快速地进行处理呢？望大侠指点啊
例子.zip (7 KB, 下载次数: 98)

2010-7-21 09:18 上传

点击文件名下载附件

Zamyi

项目以“;”为分隔符？

Zamyi

Public Sub Del()
Dim d As New Dictionary, R
R = Range("A2", Cells(65536, 1).End(3))
For i = 1 To UBound(R)
  For Each m In Split(R(i, 1), ";")
    d(m) = ""
    Next
  R(i, 1) = Join(d.Keys, ";")
  d.RemoveAll
  Next
[b2].Resize(UBound(R)) = R
Set d = Nothing
End Sub

zmdly

谢谢。不过分隔后怎么横向删除重复项呢，然后怎么再把;号比较快速地添上去呢？能不能详细点呢？

zmdly

您用的是VBA吧，有没有不用VBA的方法呢？比如函数等方法

bournechen

根据你提供的数据，每个数据用分号分隔。那么先分列，以分号进行分隔
再在后面用=IF(COUNTIF(B1:E1,B1)>1,"",B1)将不重复的数据保留
用=CONCATENATE(F1,";",G1,";",H1,";",E1)连接字符串

Zamyi

是VBA[/quote]

gongzl1981

'個人認為還是vba來處理比較好,用vba做一個函數,在a2中輸入=Getuniq(a1),再下拉就可以了.
Option Explicit
Function Getuniq(Rng As Range) As String
        Dim Arr As Variant
        Dim Str1 As String
        Dim x As Integer
        Dim Dict As Object
        
        On Error GoTo Error_Getuniq
        Application.Volatile
        Str1 = Rng.Value
        If Str1 = "" Then
                Getuniq = ""
        Else
                '創建dictionary對象
                Set Dict = CreateObject("Scripting.Dictionary")
                Arr = Split(Str1, ";")
                For x = LBound(Arr) To UBound(Arr)
                    If Not Dict.Exists(Arr(x)) Then Dict.Add Arr(x), Arr(x)
                Next
               
                Arr = Dict.keys
                Str1 = ""
                For x = LBound(Arr) To UBound(Arr)
                       Str1 = Str1 & Arr(x) & ";"
                Next
                Getuniq = Left(Str1, Len(Str1) - 1)
        End If
Exit_Getuniq:
        Set Dict = Nothing
        Exit Function
Error_Getuniq:
        Getuniq = CVErr(2015)
        GoTo Exit_Getuniq
End Function

ihelpyou

学习中。。。。。。。。。。。。。。。。。。。。。

clara123sohu

认真学习.............................