VBA/VB6移除数组中重复的数据
需要引用 'Microsoft Scripting Runtime'
代码语言：javascript复制
Function ArrDelAsMe(ByVal arr As Variant) As Variant ''数组去重复项包括重复项自身
' 这个函数是移除数组中重复的数据，包括自身
' 列如数组 Array(1,2,2,3,4,5,5,5,6) 将变成 Array(1,3,4,6)
' 需要引用 'Microsoft Scripting Runtime'，用于调用字典对象
On Error GoTo Err '错误跳转
Dim i As Long '定义数组下标
Dim val As Variant '定义数组值变量
Dim brr() As Variant '定义用于保存重复值的数组
Dim dic As New Scripting.Dictionary '定义字典，通过字典唯一值，唯一值
i = LBound(arr) '获得数组下标
For Each val In arr '数组循环取值
If Not dic.Exists(val) Then '如果字典不存在加往字典里装数据
dic.Add val, val '把数据装进字典
Else '否则就是重复的数装入数据brr
ReDim Preserve brr(i) '设置brr数组为动态数据
brr(i) = dic.Item(val) '把重复的数装入动态数组
i = i 1 '叠加量
End If '结束如果
Next '迭代
For Each val In brr '循环迭代brr数组取值
If dic.Exists(val) Then '如果存在就把相同的数据一起去除
dic.Remove (val) '删除字典中重复的数据
End If '结束如果
Next '迭代
EF:
ArrDelAsMe = dic.Keys '输出去除重复数据的数据
Erase brr '清空brr数组
Set dic = Nothing '清空字典
Exit Function '退出方法
Err: '错误提示
MsgBox "发生未知错误", vbCritical, "vb小源码"
End Function
Function ArrDel(ByVal arr As Variant) As Variant ''数组去重复项
' 这个函数是移除数组中重复的数据
' 列如数组 Array(1,2,2,3,4,5,5,5,6) 将变成 Array(1,2,3,4,5,6)
' 需要引用 'Microsoft Scripting Runtime'，用于调用字典对象
On Error GoTo Err '错误跳转
Dim i As Long '定义数组下标
Dim val As Variant '定义数组值变量
Dim dic As New Scripting.Dictionary '定义字典，通过字典唯一值，唯一值
i = LBound(arr) '获得数组下标
For Each val In arr '数组循环取值
If Not dic.Exists(val) Then '如果字典不存在加往字典里装数据
dic.Add val, val '把数据装进字典
End If '结束如果
Next '迭代
EF:
ArrDel = dic.Keys '输出去除重复数据的数据
Set dic = Nothing '清空字典
Exit Function '退出方法
Err: '错误提示
MsgBox "发生未知错误", vbCritical, "vb小源码"
End Function
Sub showme() '示例示范
Dim arr, brr, tmp, crr, temp
arr = Array(1, 2, 2, 3, 4, 5, 5, 5, 6)
brr = ArrDel(arr)
crr = ArrDelAsMe(arr)
For i = 0 To UBound(brr)
tmp = tmp & brr(i) & vbCrLf
Next
For j = 0 To UBound(crr)
temp = temp & crr(j) & vbCrLf
Next
MsgBox "原数据：Array(1, 2, 2, 3, 4, 5, 5, 5, 6)" & vbCrLf & vbCrLf & "数组去重复项(不含自身):" & vbCrLf & tmp & vbCrLf & vbCrLf & "数组去重复项(含自身):" & vbCrLf & temp, , "VB小源码"
End Sub
