'本模块 负责处理字典常用操作 封装为通用函数

Function ArrToDic(arr, keyCols, Optional Delimiter = "@@") As Object
    '数组去重得到不重复的行号 得到一个key-->多行行号集合
    '依次参数为 数组 关键字多列列号(逗号分隔的字符串,或者一维数组)
    'Delimiter 为关键字分隔符
    Dim i, dic, key, e
    If TypeName(keyCols) Like "*String" Then
        keyCols = Split(keyCols, ",")    '监测到字符串类型的多列参数 拆分为数组
    End If
    Set dic = CreateObject("scripting.dictionary")
    For i = LBound(arr) To UBound(arr)
        key = ""
        For Each e In keyCols    '构造多列key
            key = key & Delimiter & arr(i, e)
        Next
        key = Mid(key, Len(Delimiter) + 1)
        If Not dic.Exists(key) Then    '首次出现key的时候 创建集合
            dic.Add key, New Collection
        End If
        dic(key).Add i    '字典记录行号
    Next
    Set ArrToDic = dic
End Function

Function ArrQuChong(arr, keyCols, Optional IsFirst As Boolean = True, Optional Delimiter = "@@")    '数组去重
    '数组去重得到结果 可选取第一个出现还是最后一个出现
    '依次参数为 arr=数组 keyCols=关键字多列列号(逗号分隔的字符串,或者一维数组)
    'IsFirst=true代表取第一个 否则取最后一个
    Dim dic, e, i, j, c As Collection, n
    Set dic = ArrToDic(arr, keyCols)    '得到去重字典
    ReDim brr(1 To dic.Count, 1 To UBound(arr, 2))
    For i = 0 To dic.Count - 1
        Set c = dic.items()(i)    '取出集合
        n = IIf(IsFirst, 1, c.Count)    '决定取数的位置
        For j = LBound(arr, 2) To UBound(arr, 2)    '从源数据取出到结果数组
            brr(i + 1, j) = arr(c(n), j)
        Next
    Next
    ArrQuChong = brr
End Function

Sub 参数化字典去重test()
    Dim dic, arr
    Sheet3.Activate
    arr = E8_MaxRange(Sheet3.Range("A2:D2"))
    '去重输出
    brr = ArrQuChong(arr, "1,3")    '得到公司+部门去重结果
    crr = ArrQuChong(arr, "1,2")    '得到公司和服务内容去重结果
    drr = ArrQuChong(arr, "1,3,4")    '得到公司和服务内容去重结果
    Range("F2").Resize(1000, 100).ClearContents
    Range("F2").Resize(UBound(brr), UBound(brr, 2)) = brr
    Range("K2").Resize(UBound(crr), UBound(crr, 2)) = crr
    Range("P2").Resize(UBound(drr), UBound(drr, 2)) = drr
End Sub