Excel下拉列表选择后显示对应StationID的问题求助

你的代码存在几个关键问题，导致无法正常运行：

• 使用了中文全角引号（“LookUpTable”），VBA仅识别英文半角引号（"LookUpTable"），这会直接触发编译错误。
• defRange是Range对象，但未用Set关键字赋值，VBA默认会把单元格值赋给变量，而非引用单元格区域。
• 修改Target.Value会再次触发Worksheet_Change事件，引发递归循环，可能导致Excel卡顿或报错。
• 未判断Target是否为单个单元格，若用户批量修改多列数据，会引发错误。

修正后的代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅处理A列的单个单元格修改
    If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
    
    Dim siteName As String
    Dim defRange As Range
    Dim StationNum As Variant
    
    ' 关闭事件触发，避免递归
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 错误处理，确保事件最终恢复
    
    siteName = Target.Value
    ' 用英文引号+Set关键字引用跨工作表区域
    Set defRange = ThisWorkbook.Sheets("LookUpTable").Range("WISKILookupTable")
    
    StationNum = Application.VLookup(siteName, defRange, 2, False)
    If Not IsError(StationNum) Then
        Target.Value = StationNum
    End If

Cleanup:
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

关键修改说明 #

• 替换所有中文引号为英文半角引号，保证VBA能正确识别工作表和区域名称。
• 用Set关键字声明并赋值defRange，确保它指向目标工作表的查找区域。
• 添加Application.EnableEvents = False关闭事件触发，修改完单元格后再恢复，避免递归循环。
• 增加判断条件，仅处理A列的单个单元格修改，避免批量操作时的错误。
• 加入错误处理标签Cleanup，确保即使代码出错，事件触发也能恢复，防止后续Excel操作无法触发事件。

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