Oscar Sun

                  Sub 抓出易卦形造字()
Dim d As Document, a, d1 As Document, x As String
Dim dnew As Document
Set d = ActiveDocument
Set dnew = Documents.Add
Set d1 = Documents("可能是易卦形造字.docx")
x = d1.Range.Text
For Each a In d.Characters
    If InStr(x, a) > 0 And a.HighlightColorIndex = 5 Then
        If InStr(dnew.Range.Text, a) = 0 Then dnew.Range.InsertAfter a
    End If
Next
End Sub