如何修改Word宏，在提取单词首两字母时保留标点符号？

问题说明 #

处理大段文本时需将每个单词转换为前两个字母，但现有宏会移除标点符号，不符合需求。

原宏代码 #

Sub ReplaceWithFirstTwoLetters()
   Dim rng As Range, words As Variant, word As Variant, replacedText As String
   If Selection.Type = wdSelectionNormal Then Set rng = Selection.Range Else Set rng = ActiveDocument.Content
   words = Split(rng.Text, " ")
   For Each word In words
      If Len(word) > 2 Then replacedText = replacedText & Left(word, 2) & " " Else replacedText = replacedText & word & " "
   Next word
   rng.Text = Trim(replacedText)
End Sub

示例对比 #

原文：
When in the Course of human events it becomes necessary for one people to dissolve the political bands which have connected them with another, and to assume among the Powers of the earth, the separate and equal station to which the Laws of Nature and of Nature's God entitle them, a decent respect to the opinions of mankind requires that they should declare the causes which impel them to the separation.

期望结果：
Wh in th Co of hu ev it be ne fo on pe to di th po ba wh ha co th wi an, an to as am th Po of th ea, th se an eq st to wh th La of Na an of Na Go en th, a de re to th op of ma re th th sh de th ca wh im th to th se.

现有结果：
Wh in th Co of hu ev it be ne fo on pe to di th po ba wh ha co th wi an an to as am th Po of th ea th se an eq st to wh th La of Na an of Na Go en th a de re to th op of ma re th th sh de th ca wh im th to th se

问题根源 #

原宏通过空格拆分文本，将带标点的单词（如another,）视为整体，截取前两个字母后直接丢弃末尾标点；同时连字符、所有格符号也会被错误处理。

修改后的宏代码 #

Sub ReplaceWithFirstTwoLettersKeepPunctuation()
    Dim rng As Range, words As Variant, word As Variant, replacedText As String
    Dim wordPart As String, punctuation As String, i As Integer
    
    ' 确定处理范围：选中区域或整个文档
    If Selection.Type = wdSelectionNormal Then
        Set rng = Selection.Range
    Else
        Set rng = ActiveDocument.Content
    End If
    
    words = Split(rng.Text, " ")
    
    For Each word In words
        wordPart = ""
        punctuation = ""
        
        ' 分离单词主体和末尾的标点
        For i = Len(word) To 1 Step -1
            If Not (Mid(word, i, 1) Like "[A-Za-z]") Then
                punctuation = Mid(word, i, 1) & punctuation
            Else
                wordPart = Left(word, i)
                Exit For
            End If
        Next i
        
        ' 处理单词主体：长度>2取前两位，否则保留原词
        If Len(wordPart) > 2 Then
            wordPart = Left(wordPart, 2)
        End If
        
        ' 拼接处理后的单词和标点，再加空格
        replacedText = replacedText & wordPart & punctuation & " "
    Next word
    
    ' 移除末尾多余空格并替换原文本
    rng.Text = Trim(replacedText)
End Sub

代码说明 #

1. 分离标点：遍历每个单词的字符，从后往前识别非字母标点，将其与单词主体分离
2. 处理单词：对纯字母的单词主体进行首两字母截取，短单词直接保留
3. 拼接还原：将处理后的单词主体和标点重新拼接，确保标点位置不变
4. 范围兼容：支持处理选中区域或整个文档文本

内容的提问来源于stack exchange，提问作者tpp