Function 分类合并字符串(dataField As Range, kCol, rCol, f As Boolean, Optional dimstr$ = ",")
    '将关键字对应的列分组合并
    '参数=源数据,关键字列号（字符串可多列用逗号分隔如"1,3",合并列,结果去重,分隔符）
    'a = 分类合并字符串([A2:C11], "1,2", 3, True)1,2列作为关键字，合并第三列,去重
    Dim d, dx, k, r, i, x, j, kx, kc, arrKeyCol, z
    Set d = CreateObject("Scripting.Dictionary")
    Set dx = CreateObject("Scripting.Dictionary")
    kx = dataField.Value
    arrKeyCol = Split(kCol, ",")
    ReDim kc(0 To UBound(arrKeyCol))
    ReDim k(1 To UBound(kx), 1 To 1)
    
    For i = 1 To UBound(k)
        For j = 0 To UBound(arrKeyCol)
            kc(j) = kx(i, arrKeyCol(j))
        Next
        k(i, 1) = Join(kc, "@")
    Next
    
    'r = rField.Value
    Dim y()
    
    If f Then    '去重
        For i = 1 To UBound(k)
            If Not d.Exists(k(i, 1)) Then
                Set d(k(i, 1)) = CreateObject("Scripting.Dictionary")
            End If
            d(k(i, 1))(kx(i, rCol)) = 0
        Next
        x = d.keys
        ReDim arr(1 To d.Count, 1 To UBound(arrKeyCol) + 2)
        For i = 1 To UBound(x) + 1
            z = Split(x(i - 1), "@")
            For j = 0 To UBound(arrKeyCol)
                arr(i, j + 1) = z(j)
            Next
            y = d(x(i - 1)).keys
            arr(i, j + 1) = Join(d(x(i - 1)).keys, dimstr)
        Next
    Else
        For i = 1 To UBound(k)
            If Not d.Exists(k(i, 1)) Then Set d(k(i, 1)) = New Collection
            d(k(i, 1)).Add kx(i, rCol)
        Next
        x = d.keys
        ReDim arr(1 To d.Count, 1 To UBound(arrKeyCol) + 2)
        For i = 1 To UBound(x) + 1
            ReDim Preserve y(1 To d(x(i - 1)).Count)
            For j = 1 To d(x(i - 1)).Count
                y(j) = d(x(i - 1))(j)
            Next
            z = Split(x(i - 1), "@")
            For j = 1 To UBound(arrKeyCol) + 1
                arr(i, j) = z(j - 1)
            Next
            arr(i, j) = Join(y, dimstr)
        Next

    End If
    分类合并字符串 = arr
End Function