大家好，我們今天繼續講解VBA數組與字典解決方案，今日的內容是第44講，利用字典來判斷數組的值是否重複，並提取出不重複的值。對於字典的應用，排重是很普遍的應用之一。對於數組的排重，如果單用數組的內容，在我之前數組的講解中，是相當費勁的，如果利用字典，排重幾乎是不費力的就可以完成。今日就專門講解一下數組中利用字典的特性來排重處理，然後把數據裝入另外的數組，並回填。

實例的數據如下：在工作表中有下面的數據，要先放到數組中，然後進行排重處理，排重的時候要注意不要區分大小寫，排重後的數據要先放到另外一個數組中，然後回填到工作表。

如何能夠實現這個目的呢？如果是不要區分大小寫，那麼比較的模式要利用vbTextCompare，在代碼中首先要先把數據裝入數組，然後在數組中建立一個循環，利用字典，判斷是否重複，不重複的放到另外一個數組中，下面看我給出的代碼：

Sub mynzsz_44() '第44講 利用字典來判斷數組的值是否重複，並提取出不重複的值

Dim brr() '聲明一個數組brr放結果

Sheets("44").Select

Set mydic = CreateObject("scripting.dictionary")

'不區分字母大小寫比較

mydic.CompareMode = vbTextCompare

'數據源裝入數組myarr

myarr = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).row)

ReDim brr(1 To UBound(myarr), 1 To 1)

'標題行不要，開始遍歷數組

For i = 2 To UBound(myarr)

'將數據轉換成字符串類型，因爲字典關鍵字認爲數值和文本型數值是不相等的

s = myarr(i, 1)

If Not mydic.exists(s) Then

'如果字典中不存在s，則作爲關鍵字裝入字典,個數累加,結果裝入結果數組

mydic(s) = ""

k = k + 1

brr(k, 1) = myarr(i, 1)

End If

Next

[E:E].ClearContents

[E1] = "排重結果"

With [E2].Resize(k, 1)

'設置文本格式，防止某些文本數值變形

.NumberFormat = "@"

.Value = brr

End With

MsgBox "一共有：" & k & "個不重複值。"

'釋放字典內存

Set mydic = Nothing

End Sub

代碼截圖：

代碼講解：

1 上述代碼實現了對一個數組的排重處理，過程和要求的完全一致，大家要注意，實現一個目的有很多的方法，有的會簡單些，有的會複雜些，我會盡可能的多利用些方法來實現目的，讓大家在學習的過程中能有所比較，無論是哪一種方法，讀者要充分的理解，如果實在理解不了可以記住代碼爲自己所用也可。

2 Set mydic = CreateObject("scripting.dictionary")

'不區分字母大小寫比較

mydic.CompareMode = vbTextCompare

此處我給出了在字典中鍵的比較方式，是不區分大小的。

3 myarr = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).row)

ReDim brr(1 To UBound(myarr), 1 To 1)

當確定了數組myarr 後，我們就可以確定brr()的大小了。這裏我命名的這個動態數組是二維數組

4 '將數據轉換成字符串類型，因爲字典關鍵字認爲數值和文本型數值是不相等的

s = myarr(i, 1)

在這裏我給出了一個臨時的變量S，大家要理解我給出的解釋

5 If Not mydic.exists(s) Then

'如果字典中不存在s，則作爲關鍵字裝入字典,個數累加,結果裝入結果數組

mydic(s) = ""

k = k + 1

brr(k, 1) = myarr(i, 1)

End If

上述代碼中實現了對是否重複的判斷，並將不重複的值寫入數組。注意我這裏對於鍵值給出的是""，即空值

6 With [E2].Resize(k, 1)

'設置文本格式，防止某些文本數值變形

.NumberFormat = "@"

.Value = brr

End With

上述代碼實現了不重複數據的回填，不再多說了。

下面看代碼的運行：

今日內容迴向：

1 如何實現數組的排重處理？

2 數據回填要是文本格式要如何處理？

相關文章