数字前后批量添加空格和下划线（宏）

413191246se

[目标]数字前后批量添加空格和下划线：
They were at 65 and 99887.
They 4 saw 3 difference between
the 32 choices. 995 of 21, they were on cloud 9.
*方法1——【查找和替换】：
【查找内容】[0-9]{1,}
【替换为】^32^&^32
【使用通配符】√（勾选）
*方法2——VBA宏代码：（Test-OK）
*******************************************
Sub 数字前后批量添加空格和下划线()
    Dim r As Range, s As Range
    If Selection.Type = wdSelectionIP Then
        With ActiveDocument.Content.Find
            .Replacement.Font.Underline = wdUnderlineSingle
            .Execute "[0-9]{1,}", , , 1, , , , 1, , "^32^&^32", 2
        End With
    Else
        Set r = Selection.Range
        Set s = Selection.Range
        r.Find.ClearFormatting
        Do While r.Find.Execute("[0-9]{1,}", , , 1, , , , , 1, "", 0)
            r.Font.Underline = wdUnderlineSingle
            r = Chr(32) & r & Chr(32)
            r.Collapse 0
            r.SetRange Start:=r.Start, End:=s.End
        Loop
    End If
End Sub

duquancai

Sub 数字前后批量添加空格和下划线()
    Dim P As Range
    Set P = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
    With P.Find
        .Replacement.Font.Underline = wdUnderlineSingle
        .Execute "[0-9]{1,}", , , 1, , , , 0, , "^32^&^32", 2
    End With
End Sub

duquancai

Sub 数字前后批量添加空格和下划线()
    Dim P As Range, S As Range, k As Range
    Set P = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
    Set S = P.Duplicate
    With S.Find
        Do While .Execute("[0-9]{1,}", , , 1)
            If Not S.InRange(P) Then Exit Do
            With S
                Set k = S.Duplicate
                .Collapse 0: .MoveEndWhile Chr$(32)
                .Text = Chr$(32): .Font.Underline = 1
                k.SetRange k.Start, k.Start: k.MoveStartWhile Chr$(32), wdBackward
                k.Text = Chr$(32): k.Font.Underline = 1: .Collapse 0
            End With
        Loop
    End With
End Sub

duquancai

来个速度比较快的！！！
Sub 数字前后批量添加空格和下划线()
    Dim P As Range, S As Range, K As Range
    sr$ = "0123456789"
    Set P = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
    Set K = P.Duplicate
    With P
        .Collapse
        Do While .MoveUntil(sr)
            If Not .InRange(K) Then Exit Do
            .MoveEndWhile sr: Set S = P.Duplicate
            .Collapse 0: .MoveEndWhile Chr$(32)
            .Text = Chr$(32): .Font.Underline = 1
            S.SetRange S.Start, S.Start: S.MoveStartWhile Chr$(32), wdBackward
            S.Text = Chr$(32): S.Font.Underline = 1: .Collapse 0
        Loop
    End With
End Sub

413191246se

杜先生 好！
——这是我今天在网上看到 易雪龙老师的《玩转WORD高级妙招》系列讲课之一，我也想做一做，全文查找很快搞定，就是这个选区数字添加下划线，Selection半天不行，后来想到用Range来做，但也不行，再后来，根据《全角数字字母替换为半角》那个宏，要重新确定区域，才搞定。
——最近跟 杜先生 学会了《查找和替换》的简写，就是前3个逗号，后6个逗号；还有折叠Collapse，以前也不会用，现在知道写1是向前；0是向后，不用像Selection要移动字符了；还有这个IIF没用过，也不会用，会IF。
——代码3个全收藏了，等搞定《公文宏》以后再测试。
——谢谢 杜先生 关注！