Перебора EXCEL VBA словаря

Question

У меня есть VBA словарь со следующими данными:

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

У меня есть Excel документированных со следующими клетками:

POSITION SUPERVISOR_NAME 
00117886 John Doe 
00117886 John Doe2 
00117886 John Doe3 

Текущего Excel VBA кода перебирает словарь следующим образом:

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 

В результате замены имен JOHN DOE их ассоциированными Идентификаторы не имеют значения.

Вопрос: Как я могу идти о замене названия JOHN DOE со связанными с ними идентификаторами, НО только тогда, когда ПОЗИЦИЯ и SUPERVISOR_NAME из EXCEL соответствуют Словарю или ELSE не представить ничего.

Answer 1

Вы имеете в виду это?

Если предположить, что ваши имена супервизора в колонке B, начиная в строке 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 

Answer 2

Это не похоже, как вы правильно используя один из самых мощных особенностей Scripting.Dictionary объекта; что является его быстрым поиском возможностей. Вы, по сути, хотите выполнить поиск с двухколоночными критериями, поэтому используйте два столбца в качестве key и ID как 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