如何刪除列表框中的重複項目

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