VBA一对多查找 以不重数值在一个单元格显示

g416734268

VBA一对多查找 以不重数值在一个单元格显示  一对

microyip

用字典去重处理一下就可以了，学习一下字典知识吧

3190496160

Sub test()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
ar = Sheets("提取").UsedRange
ReDim br(1 To UBound(ar), 1 To 6)
For i = 2 To UBound(ar)
    If Trim(ar(i, 3)) <> "" Then
        t = d(Trim(ar(i, 3)))
        If t = "" Then
            k = k + 1
            d(Trim(ar(i, 3))) = k
            t = k
            br(k, 1) = k
            br(k, 2) = ar(i, 3)
            br(k, 3) = ar(i, 5)
        End If
        br(t, 4) = br(t, 4) + ar(i, 7)
        br(t, 6) = br(t, 6) + ar(i, 9)
        If br(t, 5) = "" Then
           br(t, 5) = ar(i, 8)
        Else
           br(t, 5) = br(t, 5) & "|" & ar(i, 8)
        End If
    End If
Next i
For i = 1 To k
    dc.RemoveAll: je = ""
    rr = Split(br(i, 5), "|")
    For s = 0 To UBound(rr)
        If Trim(rr(s)) <> "" Then
            dc(Trim(rr(s))) = ""
        End If
    Next s
    For Each kc In dc.keys
        If je = "" Then
            je = kc
        Else
            je = je & "，" & kc
        End If
    Next kc
    br(i, 5) = je
Next i
With Sheets("汇总")
    .UsedRange.Offset(1) = enpty
    .[a2].Resize(k, UBound(br, 2)) = br
End With
End Sub

3190496160

查找合并.rar (12.43 KB, 下载次数: 4)

2020-1-11 10:17 上传

点击文件名下载附件

蓝桥玄霜

单价的代码：