vba字典(dictionary)示例

option explicit
sub test()
    dim dict,arr,i
    set dict = CreateObject("Scripting.Dictionary")

    '一组数据放到字典
    arr = Range("A1").CurrentRegion
    for i = 2 to UBound(arr) step 1
        dict(arr(i,1)) = arr(i,2)
    next

    arr = Range("D1:E" & Cells(Rows.Count,"D").End(xlUp).Row)
    for i = 2 to Ubound(arr) step 1
        if dict.Exists(arr(i,1)) Then
            arr(i,2) = dict(arr(i,1))
        else
            arr(i,2) = "无对应数据"
        end if        
    next

    Range("D1").resize(ubound(arr),2) = arr

    set dict = nothing
end sub

sub Test3()
    dim dict,arr,i
    set dict = CreateObject("Scripting.Dictionary")
    arr = range("a1:b" & cells(rows.count,"a").end(xlup).row)
    for i = 1 to ubound(arr) step 1
        if not dict.exists(arr(i,1)) Then
            dict(arr(i,1)) = arr(i,2) 
        else
            dict(arr(i,1)) = dict(arr(i,1)) + arr(i,2) 
        end if
    next

    range("d:d").clearContents
    range("d1").resize(dict.count,2) =excel.application.transpose(array(dict.keys,dict.items)) 
    
    'dict.remove(xxx)
    'dict.removeall()

    set dict=nothing    
end sub

sub Test4()
    dim arr,dict,i,j
    set dict = CreateObject("Scripting.Dictionary")
    'vb的数组比较坑，维度与元素都从1开始
    arr = range("a1").currentregion
    for i = 2 to ubound(arr) step 1
        dict.removeall
        for j = 2 to ubound(arr,2)-1 step 1
            if not dict.exists(arr(i,j)) Then
                dict(arr(i,j)) = ""
            end if
        next
        arr(i,ubound(arr,2)) = join(dict.keys,",")
    next
    
    range("a1").currentregion = arr
    set dict = nothing

end sub