如何修正VBA代码，通过Application.VLookup获取准确团队名称

Sheet1工作表 #

初始化时出现的错误 #

需求说明 #

当团队成员在第2列匹配时，如何修正以下VBA代码，让Me.cmbTeam.Value（组合框）中填充准确的团队名称？

原代码 #

Private Sub UserForm_Initialize()
    Me.cmbDev.Value = "Nory"

    Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
    Dim i As Long
    Dim arr: arr = ws.Range("B1").CurrentRegion.Value
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim teamName As Variant

    For i = 2 To UBound(arr)
        dict(arr(i, 2)) = Empty
    Next
   ' ***
   
    If dict.exists(Me.cmbDev.Value) Then
        teamName = Application.VLookup(Me.cmbDev.Value, ws.Range("B1").CurrentRegion.Value, 1, False)
        Me.cmbTeam.Value = teamName '应返回结果George
    Else
        Me.cmbDev.Value = ""
        Me.cmbTeam.Value = ""
    End If

End Sub

代码修正方案 #

问题根源

1. VLookup用法错误：这个函数要求查找值必须在查找区域的第一列，但你的成员名在第2列、团队名在第1列，直接调用会触发运行时错误。
2. 字典仅存储成员名的存在性，没有关联对应的团队名称，做了冗余操作。

修正后的代码

Private Sub UserForm_Initialize()
    Me.cmbDev.Value = "Nory"

    Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
    Dim i As Long
    Dim arr: arr = ws.Range("B1").CurrentRegion.Value
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

    ' 遍历数据，把成员名（第2列）作为键，对应团队名（第1列）作为值存入字典
    For i = 2 To UBound(arr)
        ' 避免同一成员名重复存储，保留首次出现的团队关联
        If Not dict.exists(arr(i, 2)) Then
            dict(arr(i, 2)) = arr(i, 1)
        End If
    Next
   
    If dict.exists(Me.cmbDev.Value) Then
        ' 直接从字典取对应团队名，无需VLookup
        Me.cmbTeam.Value = dict(Me.cmbDev.Value) ' 返回George
    Else
        Me.cmbDev.Value = ""
        Me.cmbTeam.Value = ""
    End If

End Sub

修正要点

• 字典存键值对：直接建立成员名和团队名的映射关系，后续取值更高效，也规避了VLookup的语法限制。
• 移除错误的VLookup：用字典取值替代，彻底解决运行时错误。
• 重复成员处理：添加判断避免同一成员名多次出现时覆盖值，若业务允许覆盖可去掉该判断。

内容的提问来源于stack exchange，提问作者Shiela