给文档段落排顺序

小花鹿

查找的方法太慢了，重新写一个：
Sub test()
    Dim n&, p As Paragraph
    For Each p In ActiveDocument.Paragraphs
        With p.Range
            .End = .Start
            .MoveEndUntil ("、")
            If IsNumeric(.Text) Then
                n = n + 1
                .Text = n
            End If
        End With
    Next p
End Sub

batmanbbs

小花鹿 发表于 2024-2-18 12:00
查找的方法太慢了，重新写一个：
Sub test()
    Dim n&, p As Paragraph

赞！！！！！！！！

sylun

小花鹿 发表于 2024-2-18 12:00
查找的方法太慢了，重新写一个：
Sub test()
    Dim n&, p As Paragraph

如果编号段落前有空白段落，会出现跳号，并删除空白段落。可通过限制字符搜索长度或在条件句中添加匹配条件解决。

小花鹿

sylun 发表于 2024-2-20 21:56
如果编号段落前有空白段落，会出现跳号，并删除空白段落。可通过限制字符搜索长度或在条件句中添加匹配条 ...

是，没想到这一点，加个判断吧： If .Text Like "*[、.]*" Then

小花鹿

sylun 发表于 2024-2-20 21:56
如果编号段落前有空白段落，会出现跳号，并删除空白段落。可通过限制字符搜索长度或在条件句中添加匹配条 ...

试了试，这样也行：
Sub test()
    Dim n&, p As Paragraph, m&
    For Each p In ActiveDocument.Paragraphs
        With p.Range
            m = Len(.Text)
            .End = .Start
            .MoveEndUntil "、.", m
            If IsNumeric(.Text) Then
                n = n + 1
                .Text = n
            End If
        End With
    Next p
End Sub