如何查找以1.××××开始的句子

菜菜行者

以这样的1.××××标题开始的段落

查找[0-9]@[.．、][!。？?！：:；;]@^13，可以达到效果，但当段中有数字时，就会误把其当作标题。
比如
1.××××。面积增加了2.4亩，...............

如果在VBA里使用？

duquancai

事例文本如下（查找一级标题段落）：红色标记的查找出来（红色并非格式限定条件）。

1.2个和尚抬水吃

1个和尚挑水吃（这是正文）……

1.1.这种情况少见（二级标题）

1.1.1.这是不好搞的（三级标题）

…………

10.这个问题”5.4”这什么意思啊d

这个“5.4”表示五四青年节（这是正文）…………

10.1.发表与（二级标题）

10.1.1.这是什么（三级标题）

……………

12.中.集公司2

这样说比较好（这是正文）……..

12.1.阐述事实（二级标题）

12.2.摆事实实事求是（二级标题）

……………

92.20世纪80年代末！

20世纪80年代末我们干了什么（这是正文）………

92.1.趋势如此（二级标题）

92.1.1.当然算数（54青年节）（三级标题）

………………..

102.2016年4月15日：晴天

2016年4月15日（3.8意思是“妇女节”）她们好开心（这是正文）…………

102.1.争取的是权利（二级标题）

102.2.最终的胜利（二级标题）

Word中使用正则表达式：“^\d+\.(?:\d[^.]|\D)[^\r]*\r”

Sub 设置一级标题()

Dim reg As Object, i As Paragraph

Set reg = CreateObject("vbscript.regexp")

    For Each i In ActiveDocument.Paragraphs

        With reg

            .Pattern = "^\d+\.(?:\d[^.]|\D)"

            .Global = True: .IgnoreCase = False: .MultiLine = True

            If .test(i.Range.Text) = True Then i.Style = wdStyleHeading1

        End With

    Next

End Sub

duquancai

不够准确重新写的见楼上！！！！

菜菜行者

duquancai 发表于 2016-6-5 00:47
事例文本如下（查找一级标题段落）：红色标记的查找出来（红色并非格式限定条件）。1.2个和尚抬水吃1个和尚 ...

谢谢二回复！
现在问题是：
1、能不用标题.Style = wdStyleHeading1吗？只想改字体字号、加粗就行了；
2、你上面的红色字是独立成段，有一种情况就是红色部分结束后是有句号，然后后面的内容和它是同一段的。
比如下面这种情况

菜菜行者

duquancai 发表于 2016-6-5 00:47
事例文本如下（查找一级标题段落）：红色标记的查找出来（红色并非格式限定条件）。1.2个和尚抬水吃1个和尚 ...

谢谢回复。
现在有这种情况：
一、能不使用标题吗？我是想修改字体和颜色，用标题在实现工作中很不好掌握！
二、选择范围内替换，只替换了第1段，没能一次替换所有。

duquancai

菜菜行者 发表于 2016-6-5 14:24
谢谢回复。
现在有这种情况：
一、能不使用标题吗？我是想修改字体和颜色，用标题在实现工作中很不好掌 ...

结合你的实际情况，自己修改代码！OK

Sub test()
    With ActiveDocument.Content.Find
        .MatchWildcards = True
        .Text = "<[0-9]@[、.]"
        Do While .Execute
            With .Parent
                .Expand wdSentence
                    With .Font
                        .Bold = True
                        .Size = 18
                        .Color = wdColorRed
                        .Name = "微软雅黑"
                    End With
                .Collapse wdCollapseEnd
            End With
        Loop
    End With
End Sub
+++++++++++++++++++++++++++++++++++++++
Sub test2()
Dim reg As Object, i As Range
Set reg = CreateObject("vbscript.regexp")
    For Each i In ActiveDocument.Sentences
        With reg
            .Pattern = "^\d+[.、](?:\d[^.]|\D)"
            .Global = True: .IgnoreCase = False: .MultiLine = True
            If .test(i.Text) = True Then
                With i.Font
                        .Bold = True
                        .Size = 18
                        .Color = wdColorRed
                        .Name = "微软雅黑"
                    End With
            End If
        End With
    Next
End Sub

菜菜行者

试一下这种情况:
1.教育培育。2.5万人的。

duquancai

菜菜行者 发表于 2016-6-6 09:06
试一下这种情况:
1.教育培育。2.5万人的。

你这种情况用下面的代码：
Sub test3()
Dim reg As Object, i As Paragraph, mt, mts As Object, oRang As Range, n%
Set reg = CreateObject("vbscript.regexp")
On Error Resume Next
    For Each i In ActiveDocument.Paragraphs
        With reg
            .Pattern = "^\d+、.+?[?!。？?！：:；;\r]"
            .Global = True: .IgnoreCase = False: .MultiLine = True
             Set mts = .Execute(i.Range.Text)
            For Each mt In mts
               n = mt.Length
            Next
             Set oRang = Range(i.Range.Start, i.Range.Start + n)
                  With oRang.Font
                        .Bold = True
                        .Size = 18
                        .Color = wdColorRed
                        .Name = "微软雅黑"
                    End With
         End With
         n = 0
    Next
End Sub

13907933959

duquancai 发表于 2016-6-6 10:01
你这种情况用下面的代码：
Sub test3()
Dim reg As Object, i As Paragraph, mt, mts As Object, oRang ...

前辈好！
代码似乎运行不了，运行提示：编译错误，子过程或函数未定义。

duquancai

13907933959 发表于 2016-6-13 17:23
前辈好！
代码似乎运行不了，运行提示：编译错误，子过程或函数未定义。

我的运行没问题！下面的和上面一样的。
Sub test4()
    Dim reg As Object, i As Paragraph
    Dim mt, mts As Object, oRang As Range, n%, m%
    Set reg = CreateObject("vbscript.regexp")
    On Error Resume Next
    For Each i In ActiveDocument.Paragraphs
        With reg
            .Pattern = "^\d+、.+?[!。？?！：:；;\r]"
            .Global = True: .IgnoreCase = False
            Set mts = .Execute(i.Range.Text)
            For Each mt In mts
                m = mt.firstindex
                n = mt.Length
                Set oRang = Range _
                (i.Range.Start + m, i.Range.Start + m + n)
                With oRang.Font
                    .Bold = True
                    .Size = 18
                    .Color = wdColorRed
                    .Name = "微软雅黑"
                End With
            Next
        End With
    Next
End Sub