VB6,VBA数组去重复项函数（2个一个单去重，一个去重含自身）

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