如何修改VBA代码让下拉多选内容存入新行单元格

以下是调整后的代码，核心改动是把原本在L9单元格内换行追加内容的逻辑，改为将每个选中的选项存入L列下方的新单元格中，同时避免重复添加：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim lastRow As Long
    Dim cell As Range
    Dim isDuplicate As Boolean
    
    Application.EnableEvents = True
    On Error GoTo Exitsub
    
    ' 仅响应L9单元格的变化
    If Not Intersect(Target, Range("L9")) Is Nothing Then
        ' 确认单元格带下拉验证规则
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else
            If Target.Value = "" Then GoTo Exitsub
        End If
        
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        
        ' 检查L列后续行是否已存在当前选项
        isDuplicate = False
        lastRow = Cells(Rows.Count, "L").End(xlUp).Row
        ' 从L10开始遍历，跳过作为选择入口的L9
        For Each cell In Range("L10:L" & lastRow)
            If cell.Value = Newvalue Then
                isDuplicate = True
                Exit For
            End If
        Next cell
        
        ' 非重复值则写入L列第一个空行
        If Not isDuplicate Then
            lastRow = Cells(Rows.Count, "L").End(xlUp).Row + 1
            Cells(lastRow, "L").Value = Newvalue
        End If
        
        ' 重置L9为空，方便连续选择（不需要可注释此行）
        Target.Value = ""
    End If

Exitsub:
    Application.EnableEvents = True
End Sub

关键调整说明： #

• 新增重复值校验逻辑，防止同一选项被多次添加
• 移除原代码中在L9内拼接换行文本的逻辑，改为将新值写入L列下一个空行
• 添加L9单元格重置为空的代码，便于连续选择不同选项（不需要可手动注释该行）
• 调整遍历范围从L10开始，避免干扰作为选择入口的L9单元格

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