|
用两个字典解决
Sub 测试()
Excel.Application.ScreenUpdating = False
Excel.Application.DisplayAlerts = False
Dim arr, brr, dic, i, j, k, drr, 字典
Set dic = CreateObject("Scripting.Dictionary")
Set 字典 = CreateObject("Scripting.Dictionary")
Worksheets("培训查询").Range("c2:d6").ClearContents
arr = Worksheets("名单").Range("a1").CurrentRegion
brr = Worksheets("培训查询").Range("a2:a6")
For j = 1 To UBound(brr)
drr = Split(brr(j, 1), ",")
For i = 0 To UBound(drr)
Key = drr(i)
dic(Key) = ""
Next i
For i = 2 To UBound(arr)
If Not dic.exists(arr(i, 1)) Then 字典(arr(i, 1)) = arr(i, 1)
Next i
Worksheets("培训查询").Range("c" & j + 1) = VBA.Join(字典.Keys, ",")
k = 字典.Count
Worksheets("培训查询").Range("d" & j + 1) = k
dic.RemoveAll
字典.RemoveAll
Next j
Set dic = Nothing
Set 字典 = Nothing
Excel.Application.ScreenUpdating = True
Excel.Application.DisplayAlerts = True
End Sub
|
|