wps重新编号

gaoshuichang1

怎样将wps文字中的编号重新从1开始编号

小花鹿

Sub 题目统一编号()
    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

gwjkkkkk

利用正则参与一下。。。

gwjkkkkk

Option Explicit
Sub test4()
    Dim ar(), r&, i&, rngContent As Range, aMatch As Object, Rng As Range, m&, n&
   
    Set rngContent = ActiveDocument.Content
    With CreateObject("VBScript.RegExp")
        .Pattern = "\d+\."
        .Global = True
        For Each aMatch In .Execute(rngContent.Text)
            m = aMatch.FirstIndex: n = aMatch.Length
            Set Rng = ActiveDocument.Range(rngContent.Start + m, rngContent.Start + m + n - 1)
            If IsNumeric(Rng.Text) Then
                r = r + 1
                ReDim Preserve ar(1 To r)
                Set ar(r) = Rng
            End If
        Next
    End With
    For i = 1 To UBound(ar)
        ar(i).Text = i
    Next i
End Sub

gaoshuichang1

gwjkkkkk 发表于 2024-4-16 17:21
Option Explicit
Sub test4()
    Dim ar(), r&, i&, rngContent As Range, aMatch As Object, Rng As Ra ...

谢谢您的帮助，我想问一下880题、940题、964题的题号为什么没有变化？

gwjkkkkk

因为这几个为项目符号，可先转换

gwjkkkkk

Option Explicit
Sub test4()
    Dim a, ar(), r&, i&, rngContent As Range, aMatch As Object, Rng As Range, m&, n&
    ActiveDocument.ConvertNumbersToText
    Set rngContent = ActiveDocument.Content
    With CreateObject("VBScript.RegExp")
        .Pattern = "\d+\."
        .Global = True
        For Each aMatch In .Execute(rngContent.Text)
            m = aMatch.FirstIndex: n = aMatch.Length
            Set Rng = ActiveDocument.Range(rngContent.Start + m, rngContent.Start + m + n - 1)
            If IsNumeric(Rng.Text) Then
                r = r + 1
                ReDim Preserve ar(1 To r)
                Set ar(r) = Rng
            End If
        Next
    End With
    For i = 1 To UBound(ar)
        ar(i).Text = i
    Next i
End Sub