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