VBA多选择Listbox写入单个单元格去重问题求助

要实现GROUP名称仅显示一次，核心是先收集不重复的GROUP值，再拼接成逗号分隔的字符串。下面提供两种实用的修改方案：

方案一：用Collection自动去重（无需额外引用） #

替换你原有的GROUP收集循环代码，改用Collection对象利用其键唯一性自动过滤重复项：

Dim colGroups As New Collection
Dim x As Integer
Dim varGroup As String

' 遍历选中项，收集不重复的GROUP
On Error Resume Next ' 捕获重复添加的错误，直接跳过重复项
For x = 0 To Me.listbox_group.ListCount - 1
    If Me.listbox_group.Selected(x) Then
        ' 用GROUP值作为集合的键，重复键会触发错误被跳过
        colGroups.Add Item:=Me.listbox_group.List(x, 0), Key:=UCase(Me.listbox_group.List(x, 0))
    End If
Next x
On Error GoTo 0 ' 恢复正常错误捕获

' 将集合中的GROUP拼接成逗号分隔的字符串
If colGroups.Count > 0 Then
    varGroup = colGroups(1)
    For x = 2 To colGroups.Count
        varGroup = varGroup & ", " & colGroups(x)
    Next x
End If

' 写入单元格（保留你原有的代码）
Sheets("Data").Range("Data_Start").Offset(TargetRow, 0).Value = UCase(varGroup)

代码说明

• 集合的Key参数不允许重复，添加重复GROUP时会触发错误，通过On Error Resume Next直接跳过重复项，实现自动去重。
• 拼接字符串时从第二个元素开始加逗号，避免出现开头/结尾多余的分隔符。

方案二：用Dictionary实现（更简洁） #

如果习惯用Dictionary，可以用后期绑定无需额外引用，代码更简洁：

Dim dictGroups As Object
Set dictGroups = CreateObject("Scripting.Dictionary")
Dim x As Integer
Dim varGroup As String

' 遍历选中项，用Dictionary的Key自动去重
For x = 0 To Me.listbox_group.ListCount - 1
    If Me.listbox_group.Selected(x) Then
        dictGroups(UCase(Me.listbox_group.List(x, 0))) = True
    End If
Next x

' 直接拼接字典的所有Key为逗号分隔的字符串
varGroup = Join(dictGroups.Keys, ", ")

' 写入单元格（保留你原有的代码）
Sheets("Data").Range("Data_Start").Offset(TargetRow, 0).Value = UCase(varGroup)

代码说明

• Dictionary的Key天生具有唯一性，重复添加同一Key会自动覆盖，无需错误处理。
• 用Join函数直接将所有Key拼接成字符串，省去循环拼接的步骤。

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