循环浏览EXCEL VBA词典

Question

I have a VBA Dictionary with the following data:

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

I have an Excel documented with the following cells:

POSITION    SUPERVISOR_NAME
00117886    John Doe
00117886    John Doe2
00117886    John Doe3

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

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

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.

Answer 1

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

Answer 2

Do you mean like this?

Assuming your supervisor names are in column B starting in row 2:

Dim r As Long
Dim supervisorName As Range

For Each supervisorName In Range("B2:B" & Cells.(Rows.Count, 2).End(xlUp).Row).Cells
    If superDictionary.Exists(supervisorName.Value) Then
        r = 2 '// First row with data in
        For Each key In superDictionary.Keys
            If superDictionary(key) = supervisorName.Value And supervisorName.Row = r Then
                supervisorName.Value = key
                Exit For
            Else
                r = r + 1
            End If
        Next
    End If
Next