从Excel中的列A中删除所有重复项

我正在寻找一个可以从列 A 中删除所有重复项的宏。

我正在寻找一个可以从列 A 中删除所有重复项的宏。

输入:

John
Jimmy
Brenda
Brenda
Tom
Tom
Todd

输出:

John
Jimmy
Todd

我正在处理大量数据,Excel 不合作。似乎无法在线找到可行的解决方案。

谢谢

3

当你想去重复你的列表,这是确保你只有一个项目剩下的每个,你可以这样:

在 Excel 2007 及更高版本中,您可以在“数据”菜单中删除重复项,这将为您完成。

在 Excel 2003 及更早版本中,您可以使用数据 / 过滤器菜单中的高级过滤器:

enter image description here

然后将结果复制粘贴到新工作表中。

您可以看到完整的过程here.

否则它是一个乏味的宏来写 (一个递归循环来检查值是否存在于集合中),它是可以做到的,但是你真的需要它吗?

但是,如果你想实际删除所有相同的条目,那么使用 @ Eoins 的宏将完成这项工作,但有点修改如下:

Option Explicit
Sub DeleteDuplicate()
    Dim x, Y As Long
    Dim LastRow As Long
    Dim myCell As String
    LastRow = Range("A1").SpecialCells(xlLastCell).Row
    For x = LastRow To 1 Step -1
        myCell = Range("A" & x).Text
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), myCell) > 1 Then
            For Y = x To 1 Step -1
                If Range("A" & Y).Text = myCell Then
                    Range("A" & Y).EntireRow.Delete
                End If
            Next Y
        End If
    Next x
End Sub
2

由于您的请求是宏,请尝试:

Excel 2007 +

ActiveSheet.Range("A:A").RemoveDuplicates

这是您的 Excel 2003 选项

Option Explicit
Sub DeletDuplicate()
    Dim x As Long
    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
        Range("A" & x).EntireRow.Delete
      End If
  Next x
End Sub
2

这里是一个递归循环,以防万一你想要它:)

它实际上是 2 个过程,第一个排序列表,第二个删除重复

'----------------------------------------------------------------------
'--SORT A 1D ARRAY NUMERICALLY-ALPHABETICALLY(TAKEN FROM StackOverflow)
'----------------------------------------------------------------------
    Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
        Dim pivot   As Variant
        Dim tmpSwap As Variant
        Dim tmpLow  As Long
        Dim tmpHi   As Long
        tmpLow = inLow
        tmpHi = inHi
        pivot = vArray((inLow + inHi) \ 2)
        While (tmpLow <= tmpHi)
            While (vArray(tmpLow) < pivot And tmpLow < inHi)
                tmpLow = tmpLow + 1
            Wend
            While (pivot < vArray(tmpHi) And tmpHi > inLow)
                tmpHi = tmpHi - 1
            Wend
            If (tmpLow <= tmpHi) Then
                tmpSwap = vArray(tmpLow)
                vArray(tmpLow) = vArray(tmpHi)
                vArray(tmpHi) = tmpSwap
                tmpLow = tmpLow + 1
                tmpHi = tmpHi - 1
            End If
        Wend
        If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
        If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
    End Sub
'---------------------------------------
'--REMOVE DUPLICATES AND BLANKS FROM SORTED 1D ARRAY
'---------------------------------------
Public Function RemoveDuplicatesBlanks_1DSorted(Arr As Variant) As Variant
    Dim i As Long, iMin As Long, iMax As Long, Cnt As Long
    Dim TArr As Variant, TArr2() As Variant
    TArr = Arr
    iMin = LBound(TArr)
    iMax = UBound(TArr)
    i = iMin
    Do While i <= iMax
        If TArr(i) = vbNullString Then
            Cnt = Cnt + 1
        ElseIf i < iMax Then
            If TArr(i) = TArr(i + 1) Then
                TArr(i) = Empty
                Cnt = Cnt + 1
            End If
        End If
        i = i + 1
    Loop
    ReDim TArr2(iMin To (iMax - Cnt))
    Cnt = iMin
    For i = iMin To iMax
        If Not TArr(i) = vbNullString Then
            TArr2(Cnt) = TArr(i)
            Cnt = Cnt + 1
        End If
    Next i
    RemoveDuplicatesBlanks_1DSorted = TArr2
End Function

这些设置的方式,你会像这样使用它们.....

QuickSort MyArray, LBound(MyArray), UBOUND(MyArray)
MyArray = RemoveDuplicatesBlanks_1DSorted(MyArray)

这些工作只为 1 维数组,我也有他们的 2 维数组,如果你需要那些。

我已经使用了很多次,它们非常快,比大多数方法快得多,所以如果你有大列表,它值得使用这些方法。

----附加信息----

ExtractArrayColumn 函数位于此代码下方....这里的代码是如何使用所有这些过程

Private sub RemoveDuplicate()
    Dim MyRangeArray As Variant, MyArray As Variant
    MyRangeArray = Range("A1:A100").Value
    MyArray = ExtractArrayColumn(MyRAngeArray,1)
    QuickSort MyArray, LBound(MyArray), UBOUND(MyArray)
    MyArray = RemoveDuplicatesBlanks_1DSorted(MyArray)
    Range("A1:A100").Value = MyArray
End Sub
Public Function ExtractArrayColumn(Array_Obj As Variant, Column_Index As Long) As Variant
    Dim TArr() As Variant
    Dim L1 As Long, H1 As Long
    Dim i As Long
    L1 = LBound(Array_Obj, 1)
    H1 = UBound(Array_Obj, 1)
    ReDim TArr(L1 To H1)
    For i = L1 To H1
        TArr(i) = Array_Obj(i, Column_Index)
    Next i
    ExtractArrayColumn = TArr
End Function

本站系公益性非盈利分享网址,本文来自用户投稿,不代表码文网立场,如若转载,请注明出处

(501)
定义原子函数(atom function)
上一篇
呼叫计时器在被叫方接受呼叫后立即开始计数(call timer ios app)
下一篇

相关推荐

发表评论

登录 后才能评论

评论列表(41条)