利用字典删除重复行，保留唯一值

本文转载自公众号：VBA代码集锦，作者：水灵0115。本人收藏此文章仅为学习用，不作其他目的，感谢作者辛勤劳动。

源数据及要求：删除黄忠和庞统的各一行重复数据，两个孙权因为班级不同，保留

数据结果展示：

代码解析：

Sub DeleteSameRow1()

'删除所有重复行，保留唯一值

Dim LastRow As Long

Dim i, k, n As Long

Dim arr, brr()

Dim str As String

Application.ScreenUpdating = False

'关闭屏幕更新，以提高宏的运行效率

'建立字典对象

Set d = CreateObject('scripting.dictionary')

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'返回第一列最后一个非空行

'将数据区域导入数组

arr = Sheets('Sheet1').Range('A2:f' & LastRow)

'对数组进行循环

For k = 1 To UBound(arr)

'将每一行A-F列的内容的合并为一个文本,如果只是特定某几列，只需要修改这句代码

str = arr(k, 1) & arr(k, 2) & arr(k, 3) & arr(k, 4) & arr(k, 5) & arr(k, 6)

'对每一行的文本进行判断，如果在字典里不存在，就写入字典的关键字

        If Not d.exists(str) Then

            d(str) = ''

        Else

'否则写入数组brr，对应的值为该文本的行值，第一行是标题行，因此是k 1

            n = n 1

            ReDim Preserve brr(1 To n)

            brr(n) = k 1

        End If

Next

'对数组brr进行逆序循环，将brr数组对应的行进行删除

    For i = n To 1 Step -1

        Cells(brr(i), 1).EntireRow.Delete

    Next

Application.ScreenUpdating = True

End Sub

----------------------------------------------

感谢关注！