我创建此代码以添加用“[]”或“()”或“{}”括起来的已找到项目。如果在我的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
答案 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
注意:此代码不会按照它们在文档中显示的顺序查找条目,而是首先使用[]
,然后使用()
,然后使用{}
。
参考文献: