VBA数组与字典解决方案第44讲:利用字典排重，并提取不重复值

大家好，我们今天继续讲解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 数据回填要是文本格式要如何处理？