如何删除列表框中的重复项目

Question

我创建此代码以添加找到的项目，并用“[]”或“（）”或“{}”括起来。如果在我的文档中我有“哎呀！[哭泣]伤害！[哭泣] [笑]”，所以用“[]”括起来的项目将被添加到列表框中，并且有3个，但2个是相同的。我想合并它们。
我该怎么做？

Sub cutsound() 
    Dim arrs, arrs2, c2 As Variant, pcnt, x2, x3, intItems as Integer 

    pcnt = ActiveDocument.Paragraphs.Count 
    arrs = Array("[", "(", "{") 
    arrs2 = Array("]", ")", "}") 
    UserForm1.Show False 
    Application.ScreenUpdating = False 
    With Selection 
     .WholeStory 
     For c2 = 0 To UBound(arrs) 
      .Find.Execute (arrs(c2)) 
      Do While .Find.Found 
       .MoveEndUntil Cset:=arrs2(c2), Count:=wdForward 
       .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 
       UserForm1.ListBox1.AddItem Selection.Text 
       .MoveRight Unit:=wdCharacter, Count:=1 
       .EndKey Unit:=wdStory, Extend:=wdExtend 
       .Find.Execute 
      Loop 
     Next c2 
    End With 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

尝试在一组合并而不是列表，它维护了重复。

Answer 2

您可以使用Dictionary的密钥来实施唯一性。添加参考（工具 - >参考文件...）至Microsoft脚本运行时间。然后，请执行下列操作：

'I suggest searching using wildcards. The body of your loop will be much simpler 
Dim patterns(3) As String, pattern As Variant 
'Since these characters have special meaning in wildcards, they need a \ before them 
patterns(0) = "\[*\]" 
patterns(1) = "\(*\)" 
patterns(2) = "\{*\}" 

Dim rng As Range 'It's preferable to use a Range for blocks of text instead of Selection, 
       'unless you specifically want to change the selection 
Dim found As New Scripting.Dictionary 
For Each pattern In patterns 
    Set rng = ActiveDocument.Range 
    With rng 
     .WholeStory 
     .Find.Execute pattern, , , True 
     Do While .Find.found 
      found(rng.Text) = 1 'an arbitrary value 
      'If you want the number of times each text appears, the previous line could be modified 
      .Find.Execute 
     Loop 
    End With 
Next 

Dim key As Variant 
For Each key In found.Keys 
    Debug.Print key 
Next 

注：此代码将找不到他们在文档中出现的顺序条目，但第一项与[]，然后用()，然后用{}。

参考文献：

• Dictionary object
• Find object
• Range object