循环浏览EXCEL VBA词典

问题描述

我有一个VBA词典，其中包含以下数据:

I have a VBA Dictionary with the following data:

ID       NAME       POSITION
5008004  John Doe   00120096
5008002  John Doe2  00117886
5010010  John Doe3  00117886

我有一个包含以下单元格的Excel文档:

I have an Excel documented with the following cells:

POSITION    SUPERVISOR_NAME
00117886    John Doe
00117886    John Doe2
00117886    John Doe3

当前的Excel VBA代码以以下方式遍历字典:

Current Excel VBA code loops through the dictionary in the following fashion:

If SUPERVISOR_NAME <> "" Then
    For Each myKey In superDictionary.Keys
            If superDictionary(myKey) = SUPERVISOR_NAME Then
                SUPERVISOR_NAME = myKey
                Exit For
            End If
        Next
End If

无论如何，都会用其关联的ID替换JOHN DOE名称.

Resulting in replacing the JOHN DOE names with their associated IDs no matter what.

问题::只有当EXCEL中的POSITION和SUPERVISOR_NAME与Dictionary匹配或ELSE不提交任何内容时，我才如何用相关的ID替换JOHN DOE名称.

Question: How do I go about replacing the JOHN DOE names with their associated IDs BUT only when the POSITION and SUPERVISOR_NAME from EXCEL matches the Dictionary or ELSE submit nothing.

推荐答案

似乎您没有正确利用 Scripting.Dictionary 对象；那是它的快速检索功能.您本质上想使用两列条件执行查找，因此请将这两列用作您的 key 和ID作为项目.

It doesn't seem like you are properly utilizing one of the most powerful features of a Scripting.Dictionary object; that being its fast retrieval capabilities. You essentially want to perform a lookup with two-column criteria so use the two columns as your key and the ID as the Item.

Option Explicit

Sub supervisorIDs()
    Dim d As Variant, dict As Object
    Dim v As Long, vVALs As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    dict.comparemode = vbTextCompare  'default is vbbinarycompare

    With Worksheets("Sheet4")
        'get values from worksheet
        vVALs = .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp)).Value2
        'build dictionary
        For v = LBound(vVALs, 1) To UBound(vVALs, 1)
            'overwrite method - faster (no error control)
            'writes name&position as key, ID as item
            dict.Item(Join(Array(vVALs(v, 2), vVALs(v, 3)), ChrW(8203))) = vVALs(v, 1)
        Next v

        'loop through the second table
        For v = 2 To .Cells(Rows.Count, 6).End(xlUp).Row
            d = Join(Array(.Cells(v, 6).Value2, .Cells(v, 5).Value2), ChrW(8203))
            If dict.exists(d) Then _
                .Cells(v, 7) = dict.Item(d)
        Next v
    End With
End Sub

这篇关于循环浏览EXCEL VBA词典的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！