How to remove duplicate items in listbox

问题:

I created this code to add found items enclosed with "[]" or "()" or "{}". If in my word document I have "ouch! [crying] That hurts! [crying] [laughing]" so the items enclosed with "[]" will be added to the listbox and there are 3 of it but the 2 are the same. I want to merge them.
How would I do that?

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

回答1:

Try to merge in a set rather then list, it maintains the duplication.

回答2:

You could use the keys of a Dictionary to enforce uniqueness. Add a reference (Tools -> References...) to Microsoft Scripting Runtime. Then, do the following:

'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

Note: this code won't find entries in the order they appear in the document, but first entries with [], then with (), then with {}.

References:

• Dictionary object
• Find object
• Range object