循环通过EXCEL VBA词典

我有一个带有以下数据的VBA词典：

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

我有一个Excellogging下面的单元格：

 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名称replace为相关的ID。

问题：如何replaceJOHN DOE名称及其关联的ID，但只有当EXCEL的POSITION和SUPERVISOR_NAME匹配Dictionary或ELSE时，才会提交。

Answer 1

看起来好像没有正确使用Scripting.Dictionary对象最强大的function之一; 这是它的快速检索function。 你基本上想要执行一个双列标准的查找，所以使用两列作为你的关键和ID作为项目 。

 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

你是这个意思吗？

假设你的主pipe名字在第2行的B列开始：

 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