源數據及要求：刪除黃忠和龐統的各一行重復數據，兩個孫權因為班級不同，保留

數據結果展示：

代碼解析：

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

總結

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

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。