Excel 365：点击指定合并单元格弹出可编辑多选Listbox的实现问询

这个需求完全可以实现，以下是具体的VBA代码实现步骤：

1. 创建用户窗体 #

• 插入一个用户窗体（UserForm1），添加以下控件：
  • 一个ListBox控件（命名为ListBoxRecur），设置其MultiSelect属性为fmMultiSelectMulti
  • 两个CommandButton控件，分别命名为cmdOK（标题“确定”）和cmdCancel（标题“取消”）

2. 工作表事件代码 #

在包含「Recur」命名区域的工作表代码模块中添加以下代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngRecur As Range
    Dim wsSource As Worksheet
    Dim arrItems As Variant
    Dim i As Integer
    Dim existingVals As Variant
    Dim val As Variant
    
    ' 绑定「Recur」命名区域和数据源工作表
    Set rngRecur = ThisWorkbook.Names("Recur").RefersToRange
    Set wsSource = ThisWorkbook.Worksheets("你的数据源工作表名称") ' 替换为实际工作表名
    
    ' 判断选中区域是否在「Recur」范围内
    If Not Intersect(Target, rngRecur) Is Nothing Then
        ' 读取「Recurrence」命名区域的选项
        arrItems = wsSource.Names("Recurrence").RefersToRange.Value
        
        ' 清空ListBox并加载选项
        UserForm1.ListBoxRecur.Clear
        For i = LBound(arrItems) To UBound(arrItems)
            UserForm1.ListBoxRecur.AddItem arrItems(i, 1)
        Next i
        
        ' 根据单元格已有内容，自动勾选ListBox对应项
        If Target.Value <> "" Then
            existingVals = Split(Target.Value, ", ")
            For Each val In existingVals
                For i = 0 To UserForm1.ListBoxRecur.ListCount - 1
                    If UserForm1.ListBoxRecur.List(i) = val Then
                        UserForm1.ListBoxRecur.Selected(i) = True
                        Exit For
                    End If
                Next i
            Next val
        End If
        
        ' 显示窗体，位置对齐选中单元格
        With UserForm1
            .Top = Target.Top + Target.Height
            .Left = Target.Left
            .Show
        End With
    End If
End Sub

3. 用户窗体代码 #

在UserForm1的代码模块中添加以下代码：

Private Sub cmdCancel_Click()
    ' 取消操作，隐藏窗体
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Dim wsTarget As Worksheet
    Dim targetCell As Range
    Dim selectedItems As String
    Dim i As Integer
    Dim newVals As Collection
    Dim val As Variant
    
    Set wsTarget = ThisWorkbook.Worksheets("目标工作表名称") ' 替换为实际工作表名
    Set targetCell = wsTarget.Range("Recur") ' 指向「Recur」命名区域
    
    ' 用集合存储最终选中项，自动去重
    Set newVals = New Collection
    
    ' 遍历ListBox，收集所有选中项
    For i = 0 To Me.ListBoxRecur.ListCount - 1
        If Me.ListBoxRecur.Selected(i) = True Then
            On Error Resume Next
            newVals.Add Me.ListBoxRecur.List(i), Key:=CStr(Me.ListBoxRecur.List(i))
            On Error GoTo 0
        End If
    Next i
    
    ' 将集合转为逗号分隔的字符串
    For Each val In newVals
        If selectedItems = "" Then
            selectedItems = val
        Else
            selectedItems = selectedItems & ", " & val
        End If
    Next val
    
    ' 更新目标单元格内容
    targetCell.Value = selectedItems
    
    ' 隐藏窗体
    Me.Hide
End Sub

功能说明 #

• 点击「Recur」区域时自动弹出ListBox，加载「Recurrence」的所有选项，并根据单元格现有内容自动勾选对应项
• 支持多选，取消勾选的原有内容会自动移除，新勾选的内容会添加进去
• 点击「确定」后，选中项会以逗号分隔的形式填充到目标单元格；点击「取消」直接关闭窗体，不修改内容

注意：需将代码中的「你的数据源工作表名称」和「目标工作表名称」替换为实际的工作表名称。

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