大家好，今日我們繼續講解VBA數組與字典解決方案，今日講解第52講：利用字典，提取兩列數據重復值。有人講:字典是VBA中最為精華的部分,持這種觀點的人肯定有自己的道理,確實,利用字典可以給我的代碼帶來很大的方便之處,今日我講解的是利用字典,提取兩列的重復數據.在實際的工作中排重和提取重復的數據是很常見的工作,如果直接進行比較核對,真的很費事費時,之前我講過數據庫的方法,不失為一種好的方案.今日我們講解利用字典的方法,這也是一種非常好的方案.

實例,下面的AB列數據,我們要提取出在A中與B列重復的數據,該如何進行?

我們首先看看數據,很多是重復的,我們首先要進行排重處理,一般的方案難于應付,下面看我給出的字典方案代碼:

Sub mynzsz_52() '第52講 利用字典，提取兩列數據重復值

Sheets("52").Select

Set mydic = CreateObject("Scripting.Dictionary")

myarr1 = Range([A2], [A65536].End(xlUp))

myarr2 = Range([B2], [B65536].End(xlUp))

For i = 1 To UBound(myarr1)

'將鍵值賦值為0

mydic(myarr1(i, 1)) = 0

Next

For j = 1 To UBound(myarr2)

'如果數組2在字典中存在相應的鍵，那么將鍵值更改為1

If mydic.exists(myarr2(j, 1)) Then mydic(myarr2(j, 1)) = 1

Next

'對于字典中的每個鍵進行判斷，如果相應的鍵值為0，也就是說在數組2中不存在，那么移除

For Each d In mydic.keys

If mydic(d) = 0 Then mydic.Remove (d)

Next

'將字典數據回填到工作表

[e:e].ClearContents

Range("e1") = "A列中與B列重復的值"

Range("e2").Resize(mydic.Count, 1) = WorksheetFunction.Transpose(mydic.keys)

End Sub

代碼截圖:

代碼解析:

1 上述代碼實現了提取重復數據并排重的功能,代碼簡潔,操作靈活.

2. Set mydic = CreateObject("Scripting.Dictionary")

上述代碼創建了一個字典

3. myarr1 = Range([A2], [A65536].End(xlUp))

myarr2 = Range([B2], [B65536].End(xlUp))

上述代碼分別將兩列數據放到數組中.

4 For i = 1 To UBound(myarr1)

'將鍵值賦值為0

mydic(myarr1(i, 1)) = 0

Next

將數組1的數據放到字典的鍵中同時鍵值賦值為0

5 For j = 1 To UBound(myarr2)

'如果數組2在字典中存在相應的鍵，那么將鍵值更改為1

If mydic.exists(myarr2(j, 1)) Then mydic(myarr2(j, 1)) = 1

Next

在數組2中建立循環,如果在字典中存在相應的鍵,那么將鍵值更正為1

6 For Each d In mydic.keys

If mydic(d) = 0 Then mydic.Remove (d)

Next

將字典中的數據進行處理,假如鍵值為0,那么移除

7 '將字典數據回填到工作表

[e:e].ClearContents

Range("e1") = "A列中與B列重復的值"

Range("e2").Resize(mydic.Count, 1) = WorksheetFunction.Transpose(mydic.keys)

上述代碼數據回填.

下面看代碼的運行:

今日內容回向:

1 利用字典如何獲取重復數據的值?

2 上述代碼中為什么要對鍵值重新賦值?

總結

以上是生活随笔為你收集整理的vba 提取 json某个值_利用VBA字典，提取两列数据的重复值的全部內容，希望文章能夠幫你解決所遇到的問題。

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