word 正则无果：将文档中以数字开头的段落依次录入数组

weiyingde

Sub 将文档中以数字开头的段落依次录入数组()
Dim arr(), m
With ActiveDocument.Content
         .Find.Execute "^w", , , , , , , , , "^32", 2
         .Find.Execute "([!A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([!A-Za-z])(^32)([A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "^11", , , 1, , , , , , "^p", 2 '
         .Find.Execute "(^32{1,})(*)(^13)", , , 1, , , , , , "\2\3", 2
         .Find.Execute "(*)(^13)(^32{1,})", , , 1, , , , , , "\1\2", 2
End With
Set sr = ActiveDocument.Content
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "[\d]{1,}.*^13"
        For Each m In .Execute(sr)
          n = n + 1
          ReDim Preserve arr(1 To n)
          arr(n) = m.Value
        Next
        For i = LBound(arr) To UBound(arr)
          MsgBox arr(i)
        Next
End With
End Sub

duquancai

Sub 将文档中以数字开头的文段依次录入数组()
    Dim doc As Document, j&, ksr$, x&, arr()
    Set doc = ActiveDocument
    With doc.Content.Find
        Do While .Execute("[0-9]{1,}", , , 1)
            With .Parent
                If Not .Information(wdWithInTable) Then
                    x = Len(.Text): ksr = .Text
                    .Expand 4: .Collapse
                    If .MoveWhile(ksr, x) = x Then
                        n = n + 1: ReDim Preserve arr(1 To n)
                        .Expand 4: arr(n) = .Text: .Collapse 0
                    Else
                        .Move 4, 1
                    End If
                End If
            End With
        Loop
    End With
End Sub

weiyingde

duquancai 发表于 2017-5-24 21:44
Sub 将文档中以数字开头的文段依次录入数组()
    Dim doc As Document, j&, ksr$, x&, arr()
    Set do ...

谢谢，在此代码。

weiyingde

自我解决代码，用正则，如下：
Sub 将文档中以数字开头的文段依次录入数组()
Dim arr(), m
With ActiveDocument.Content
         .Find.Execute "^w", , , , , , , , , "^32", 2
         .Find.Execute "([!A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([!A-Za-z])(^32)([A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "^11", , , 1, , , , , , "^p", 2 '
         .Find.Execute "(^32{1,})(*)(^13)", , , 1, , , , , , "\2\3", 2
         .Find.Execute "(*)(^13)(^32{1,})", , , 1, , , , , , "\1\2", 2
End With
Set sr = ActiveDocument.Content
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "^\d+[^\r\n]+$[\n\r]"
        For Each m In .Execute(sr)
          n = n + 1
          ReDim Preserve arr(1 To n)
          arr(n) = m.Value
        Next
        For i = LBound(arr) To UBound(arr)
          MsgBox arr(i)
        Next
End With
End Sub

duquancai

weiyingde 发表于 2017-5-24 22:26
自我解决代码，用正则，如下：
Sub 将文档中以数字开头的文段依次录入数组()
Dim arr(), m

Sub 将文档中以数字开头的文段依次录入数组()
    Dim arr(), m
    sr = ActiveDocument.Content
    With CreateObject("vbscript.regexp")
        .Global = True: .MultiLine = True
        .Pattern = "^[\xa0\u3000\s]*\d+[^\r]+"
        For Each m In .Execute(sr)
            n = n + 1
            ReDim Preserve arr(1 To n)
            arr(n) = m.Value
        Next
        For i = LBound(arr) To UBound(arr)
            MsgBox arr(i)
        Next
    End With
End Sub

weiyingde

duquancai 发表于 2017-5-24 23:13
Sub 将文档中以数字开头的文段依次录入数组()
    Dim arr(), m
    sr = ActiveDocument.Content

杜老师，非常好，我将它录入字典如何？怎么出现问题？
Sub 将文档中以数字开头的文段依次录入字典()
Dim arr(), m, d as dictionary, Mdoc As Document
Set d = CreateObject("scripting.dictionary")
Set sr = ActiveDocument.Content
With CreateObject("vbscript.regexp")
     .Global = True
     .IgnoreCase = False
     .MultiLine = True
     .Pattern = "^(\d+)[^\r\n]+$[\n\r]"
        For Each m In .Execute(sr)
          Set d(m.SubMatches(0)) = m.Value
        Next
End With

weiyingde

在求大侠指点，为什么会出错。

jiminyanyan

weiyingde 发表于 2017-5-24 22:26
自我解决代码，用正则，如下：
Sub 将文档中以数字开头的文段依次录入数组()
Dim arr(), m

这个不叫正则表达式吧。。。。。

weiyingde

"^(\d+)[^\r\n]+$[\n\r]"
正是

jiminyanyan

http://club.excelhome.net/thread-1343056-1-1.html
和我的差不多吧。。。。