源數(shù)據(jù)及要求：刪除黃忠和龐統(tǒng)的各一行重復(fù)數(shù)據(jù)，兩個(gè)孫權(quán)因?yàn)榘嗉?jí)不同，保留

數(shù)據(jù)結(jié)果展示：

代碼解析：

Sub DeleteSameRow1()

'刪除所有重復(fù)行，保留唯一值

Dim LastRow As Long

Dim i, k, n As Long

Dim arr, brr()

Dim str As String

Application.ScreenUpdating = False

'關(guān)閉屏幕更新，以提高宏的運(yùn)行效率

'建立字典對(duì)象

Set d = CreateObject("scripting.dictionary")

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

'返回第一列最后一個(gè)非空行

'將數(shù)據(jù)區(qū)域?qū)霐?shù)組

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

'對(duì)數(shù)組進(jìn)行循環(huán)

For k = 1 To UBound(arr)

'將每一行A-F列的內(nèi)容的合并為一個(gè)文本,如果只是特定某幾列，只需要修改這句代碼

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

'對(duì)每一行的文本進(jìn)行判斷，如果在字典里不存在，就寫入字典的關(guān)鍵字

If Not d.exists(str) Then

d(str) = ""

Else

'否則寫入數(shù)組brr，對(duì)應(yīng)的值為該文本的行值，第一行是標(biāo)題行，因此是k+1

n = n + 1

ReDim Preserve brr(1 To n)

brr(n) = k + 1

End If

Next

'對(duì)數(shù)組brr進(jìn)行逆序循環(huán)，將brr數(shù)組對(duì)應(yīng)的行進(jìn)行刪除

For i = n To 1 Step -1

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

Next

Application.ScreenUpdating = True

End Sub

總結(jié)

以上是生活随笔為你收集整理的excel删除重复数据保留一条_VBA利用字典删除重复行，保留唯一值的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。