Excel VBA实现多选数据验证下拉框选项自动添加复选标记

以下是修改后的代码，可实现多选时每个选项开头自动添加复选标记，仅选单个选项时不添加：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim valuesArray As Variant
    Dim combinedValue As String
    Dim i As Integer
    
    Application.EnableEvents = True
    On Error GoTo Exitsub
    
    ' 限定生效的单元格范围
    If Not Intersect(Target, Range("C3:C28,F3:F28,G3:G28,H3:H28,J3:J28,L3:L28,M3:M28,N3:N28")) Is Nothing Then
        ' 检查单元格是否有数据验证规则
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        End If
        
        ' 单元格为空时直接退出
        If Target.Value = "" Then
            GoTo Exitsub
        End If
        
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        
        ' 处理选中值到数组中
        If Oldvalue <> "" Then
            ' 拆分旧值为数组，移除已有的复选标记并去除首尾空格
            valuesArray = Split(Oldvalue, vbNewLine)
            For i = LBound(valuesArray) To UBound(valuesArray)
                valuesArray(i) = Trim(Replace(valuesArray(i), ChrW(&H2713), ""))
            Next i
            
            ' 检查新值是否已存在，不存在则添加到数组
            If IsError(Application.Match(Newvalue, valuesArray, 0)) Then
                ReDim Preserve valuesArray(UBound(valuesArray) + 1)
                valuesArray(UBound(valuesArray)) = Newvalue
            End If
        Else
            ' 旧值为空，数组仅包含新值
            ReDim valuesArray(0)
            valuesArray(0) = Newvalue
        End If
        
        ' 构建最终显示的字符串
        If UBound(valuesArray) = 0 Then
            ' 仅单个选项，不添加复选标记
            combinedValue = valuesArray(0)
        Else
            ' 多个选项，每个选项前添加复选标记
            combinedValue = ""
            For i = LBound(valuesArray) To UBound(valuesArray)
                combinedValue = combinedValue & ChrW(&H2713) & " " & valuesArray(i) & vbNewLine
            Next i
            ' 移除末尾多余的换行符
            combinedValue = Left(combinedValue, Len(combinedValue) - Len(vbNewLine))
        End If
        
        Target.Value = combinedValue
    End If
    
Exitsub:
    Application.EnableEvents = True
End Sub

代码说明： #

• 范围限定：仅对指定的单元格区域生效，可根据需求调整Range参数。
• 去重处理：自动检测新选项是否已存在，避免重复添加。
• 复选标记逻辑：
  • 仅选中1个选项时，直接显示选项文本，无复选标记。
  • 选中多个选项时，每个选项前自动添加✓（Unicode字符ChrW(&H2713)）。
• 兼容旧数据：自动移除原代码中已添加的复选标记，重新统一格式，确保所有多选选项都有标记。

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