如何通过VBA删除括号内光标所在中文词（组）外的内容?

tangqingfu

辛苦sylun兄了!效果很不错！
请教sylun兄，如何让代码能更识别、处理这些问题：
1、各意思音有些是以空格分隔的；
2、中文意思是以...开头或结尾的(非…）；
3、像这样的情况：如：    一(个，件)
请测试附件中的红色或蓝色字体部分

kepeng100

如果是【..........】 就可以用【*】直接查找替换就行了,可惜( ) 括号的就不行了!

sylun

原帖由 tangqingfu 于 2009-7-31 22:11 发表
辛苦sylun兄了!效果很不错！
请教sylun兄，如何让代码能更识别、处理这些问题：
1、各意思音有些是以空格分隔的；
2、中文意思是以...开头或结尾的(非…）；
3、像这样的情况：如：    一(个，件)
请测试附件中 ...

楼主的问题真不少，但最好还是一次性地讲清楚，不必急着提问。不同的情形处理思路可能是不一样的，要多次另起炉灶效率很低。
可试试如下代码：
Sub test3()
Dim TF As Boolean, myRange As Range
With Selection
    If .Type <> wdSelectionIP Then Exit Sub
    Set myRange = .Paragraphs(1).Range
    With myRange.Find  '确定每一对括号（如果有）的内容范围
        .ClearFormatting
        .Text = "\(*\)"
        .MatchWildcards = True
        Do While .Execute
            With .Parent
                Do While UBound(Split(.Text, "(")) <> UBound(Split(.Text, ")"))  '处理嵌套括号内容
                    .MoveEndUntil ")"
                    .End = .End + 1
                Loop
                If Selection.InRange(myRange) Then  '如果插入点在该对括号内容范围内
                    TF = True
                    .SetRange .Start + 1, .End - 1  '确定所指目标内容范围
                    Exit Do
                End If
                .Collapse wdCollapseEnd
            End With
        Loop
        If TF = False Then Exit Sub
    End With
100
    Do While .Previous Like "[!，；]" And .Start > myRange.Start  '确定所需保留内容的起始位置
        .Start = .Start - 1
    Loop
200
    Do While .Next Like "[!，；]" And .End < myRange.End  '确定所需保留内容的结束位置
        .End = .End + 1
    Loop
    If UBound(Split(.Text, "(")) < UBound(Split(.Text, ")")) Or UBound(Split(.Text, "（")) < UBound(Split(.Text, "）")) Then
        .Start = .Start - 1
        GoTo 100
    ElseIf UBound(Split(.Text, "(")) > UBound(Split(.Text, ")")) Or UBound(Split(.Text, "（")) > UBound(Split(.Text, "）")) Then
        .End = .End + 1
        GoTo 200
    End If
    myRange.Text = .Text
    '试图删除词性缩写词（存在误删可能）
    If InStr(myRange, ".") > 0 And myRange Like "[!.]*" And Left(myRange, InStr(myRange, ".")) Like "*[一-龥]*" = False _
        Then myRange.Text = Mid(myRange, InStr(myRange, ".") + 1)
End With
End Sub
至于空格分隔问题，请自行处理。如，可试试在代码中的[!，；]添加空格字符，但如果当中空格的用途不是唯一的就会导致误处理。

[ 本帖最后由 sylun 于 2009-8-1 00:50 编辑 ]

wjhere

sylun兄的代码太好了。处理了大多数的情形。
还有一个小问题，如 vt.喜欢；喜爱 prep.像；跟…一样；v.希望，想要
这段解释中 喜爱 prep.像 其实是两种词性的解释，喜爱属于前面，中间没有分隔符（好像有空格）。能不能以这个 prep. 分隔符，得到 喜爱 和prep.像

sylun

原帖由 wjhere 于 2009-8-1 05:22 发表
sylun兄的代码太好了。处理了大多数的情形。
还有一个小问题，如 vt.喜欢；喜爱 prep.像；跟…一样；v.希望，想要
这段解释中 喜爱 prep.像 其实是两种词性的解释，喜爱属于前面，中间没有分隔符（好像有空格）。能 ...

在总体判断上，判断标准就算再复杂也应该是唯一的，否则就会因逻辑混乱而导致处理结果异常。从附件的排版格式特征来看，格式是混乱的，描述也不太到位。具体来说，如果不同词性间用空格，那么如何判断它与两个正常单词间的空格的区别？按通常理解，用逗号和分号就可区分，如分号用于分隔不同词性，而相同词性中的不同解释用逗号分隔。就算一定要用空格区分，我想起码也应用两个以上连续的空格，以区别于单词之间正常的空格。至于以词性缩写来区分，一来也许这并非楼主的本意，二来不能保证解释中没有非词性缩写的带点号的缩略语。总的来说，我觉得如以空格来判断，其标准是模糊的，描述上也含糊不清，从所提供的实例看，排版格式上也是不太可行的。

wjhere

谢谢sylun兄。看来主要从根源入手规范这些词条格式。

tangqingfu

非常感谢sylun兄!测试效果很理想!
收藏使用!

kqbt

针对最简单的情况写了一个，自己留着用。
Sub kqbt()
  Set myRange = Selection.Range
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True
    .Replacement.Text = ""
    If .Execute(findtext:="[(]", Forward:=False) Then
      Set lRange = Selection.Range
      Set lmyRange = Range(lRange.End, myRange.Start)
      If InStr(lmyRange, ")") > 0 Then GoTo ex
      
        myRange.Select
        .Execute findtext:="[；，)]", Forward:=True
    Set eRange = Selection.Range        
        If eRange = "；" Or eRange = "，" Then
        Selection.MoveLeft
        .Execute findtext:="[，；.(]", Forward:=False
        Set sRange = Selection.Range
        Set oRange = Range(sRange.End, eRange.Start)
         
          myRange.Select
          .Execute findtext:="[)]", Forward:=True
            Set rRange = Selection.Range
            Set bRange = Range(lRange.End, oRange.Start)
            Set aRange = Range(oRange.End, rRange.Start)
            
            bRange.Delete
            aRange.Delete
            Selection.MoveLeft
            
        Else
            Selection.MoveLeft
            .Execute findtext:="[，；.(]", Forward:=False
            Set sRange = Selection.Range
            Set oRange = Range(sRange.End, eRange.Start)
            Set bRange = Range(lRange.End, oRange.Start)
            
            bRange.Delete
            
        End If
              
    Else
ex:
     myRange.Select
     MsgBox "光标不在括号内！"
     Exit Sub
    End If
  End With
End Sub