如何让Excel VBA实现多列下拉列表多选功能？

原代码通过Target.Column = 8限制了仅第8列（H列）生效，要支持多列，只需修改列的判断逻辑，以下是两种可行方案：

方案1：指定特定列生效 #

如果只想让某几列（比如第8、9、10列）支持多选，将原代码中的列判断条件替换为多列匹配逻辑：

修改后的完整代码：

Private Sub Worksheet_Change(ByVal Target As Range)
' 支持多列下拉列表多选（避免重复）
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub

' 修改此处：指定需要生效的列，示例为第8、9、10列
If Not IsError(Application.Match(Target.Column, Array(8, 9, 10), 0)) Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else
    If Target.Value = "" Then GoTo Exitsub
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
        Else
          Target.Value = Oldvalue
        End If
      End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

• 改动说明：用Application.Match判断目标列是否在Array(8,9,10)中，你可以根据需求添加或修改数组里的列序号。

方案2：所有带数据验证的列自动生效 #

如果希望所有设置了下拉列表（数据验证）的列都支持多选，直接删除原代码中的列判断语句即可：

修改后的完整代码：

Private Sub Worksheet_Change(ByVal Target As Range)
' 所有带数据验证的列支持下拉多选（避免重复）
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub

' 移除了原有的列判断，仅保留数据验证检查
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
  GoTo Exitsub
Else
  If Target.Value = "" Then GoTo Exitsub
  Application.EnableEvents = False
  Newvalue = Target.Value
  Application.Undo
  Oldvalue = Target.Value
    If Oldvalue = "" Then
      Target.Value = Newvalue
    Else
      If InStr(1, Oldvalue, Newvalue) = 0 Then
          Target.Value = Oldvalue & ", " & Newvalue
      Else
        Target.Value = Oldvalue
      End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

• 改动说明：删除了If Target.Column = 8 Then这一行，代码会自动对所有带有数据验证的单元格生效，无需指定列。

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