VBA结合VLookup实现数据验证下拉多选值存入单个单元格问题咨询

完整可用代码 #

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    Dim matchVal As String
    Dim lUsed As Long
    
    ' 批量修改直接退出
    If Target.Count > 1 Then GoTo exitHandler
    
    ' 判断是否为数据验证单元格
    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
    If Intersect(Target, rngDV) Is Nothing Then GoTo exitHandler
    
    ' 仅处理第8列（H列），如需适配其他列可修改此处列号
    If Target.Column <> 8 Then GoTo exitHandler
    
    Application.EnableEvents = False
    ' 保存新选中的下拉值，获取单元格原有值
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
    
    ' VLookup匹配对应值，匹配失败时保留原选中值
    matchVal = Application.VLookup(newVal, Worksheets("Zones").Range("Zone"), 2, False)
    If IsError(matchVal) Then matchVal = newVal
    
    ' 多值拼接逻辑
    If oldVal = "" Then
        ' 原单元格为空直接赋值
        Target.Value = matchVal
    Else
        If newVal = "" Then
            ' 清空操作直接返回空值
            Target.Value = ""
        Else
            ' 检查值是否已存在，避免重复添加
            lUsed = InStr(1, "|" & oldVal & "|", "|" & matchVal & "|")
            If lUsed > 0 Then
                ' 已存在保留原值
                Target.Value = oldVal
            Else
                ' 不存在则用分隔符拼接
                Target.Value = oldVal & "|" & matchVal
            End If
        End If
    End If

exitHandler:
    Application.EnableEvents = True
End Sub

使用说明 #

• 将代码粘贴到需要实现功能的工作表的代码编辑窗口即可生效：右键工作表标签→选择「查看代码」即可打开对应窗口
• 确保Zones工作表中名为Zone的命名区域配置正确：区域第一列为数据验证下拉的可选值，第二列为需要返回的匹配值
• 多值默认使用|作为分隔符，可按需修改拼接语句中的分隔符为逗号、空格等其他符号

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