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

时间:2015-07-21 06:48:51

标签: vba ms-word listbox word-vba

我创建此代码以添加用“[]”或“()”或“{}”括起来的已找到项目。如果在我的Word文档中我有“哎哟![哭泣]那伤害![哭泣] [笑]”所以用“[]”括起来的项目将被添加到列表框中,其中有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

2 个答案:

答案 0 :(得分:0)

尝试合并一个集合而不是列表,它会保留重复。

答案 1 :(得分:0)

您可以使用Dictionary的键来强制执行唯一性。将参考(工具 - >参考... )添加到 Microsoft Scripting Runtime 。然后,执行以下操作:

'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

注意:此代码不会按照它们在文档中显示的顺序查找条目,而是首先使用[],然后使用(),然后使用{}

参考文献: