如何删除列表框中的重复项 [英] How to remove duplicate items in listbox

问题描述

我创建了这段代码，以添加找到的项目，并用"[]"或()"或"{}"括起来.如果在我的Word文档中我有哎呀！ .我要合并它们.
我该怎么办?

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

推荐答案

您可以使用

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 {}.

参考文献:

• 字典对象
• 查找对象
• 范围对象

• Dictionary object
• Find object
• Range object

这篇关于如何删除列表框中的重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！