在word里，对一句话里（逗号为一句话）没有数字或者数字为0.0的则删除

过客fppt

sunfei00426 发表于 2024-4-17 09:28
很好，没有意见，请大神展示一下结果如何

你先和这些帮你的老师说一声谢谢，再送两朵，免费的花花，我再给你发

sunfei00426

没问题没问题，感谢大家

sunfei00426

bxm78 发表于 2024-4-17 10:14
请试用，有问题再联系。

太棒了！
但还有最后2个小问题请帮忙解决一下：
1.就比如XX县（或者XX区、XX委）后面跟着规下工业之类这样的表述，可能也没有数字，但是如果删除的话，会把XX县这些地区也删除了，但其实需要保留XX县，否则后面跟的内容不知道是说什么地方了。
2.文中有“（低于全市、全省水平的县区有：**区、**区、**县、**县、**委）”和“（低于全市水平的县区有：**区、**区、**县、**县、**委）”这两类虽然也没有数字，但不能删除。

sunfei00426

过客fppt 发表于 2024-4-17 11:58
你先和这些帮你的老师说一声谢谢，再送两朵，免费的花花，我再给你发

太棒了！
但还有最后2个小问题请帮忙解决一下：
1.就比如XX县（或者XX区、XX委）后面跟着规下工业之类这样的表述，可能也没有数字，但是如果删除的话，会把XX县这些地区也删除了，但其实需要保留XX县，否则后面跟的内容不知道是说什么地方了。
2.文中有“（低于全市、全省水平的县区有：**区、**区、**县、**县、**委）”和“（低于全市水平的县区有：**区、**区、**县、**县、**委）”这两类虽然也没有数字，但不能删除。

sunfei00426

bxm78 发表于 2024-4-17 10:14
请试用，有问题再联系。

太棒了！
但还有最后2个小问题请帮忙解决一下：
1.就比如XX县（或者XX区、XX委）后面跟着规下工业之类这样的表述，可能也没有数字，但是如果删除的话，会把XX县这些地区也删除了，但其实需要保留XX县，否则后面跟的内容不知道是说什么地方了。如图1
2.文中有“（低于全市、全省水平的县区有：**区、**区、**县、**县、**委）”和“（低于全市水平的县区有：**区、**区、**县、**县、**委）”这两类虽然也没有数字，但不能删除。如图2

过客fppt

sunfei00426 发表于 2024-4-17 15:11
太棒了！
但还有最后2个小问题请帮忙解决一下：
1.就比如XX县（或者XX区、XX委）后面跟着规下工业之类 ...

我的一个自定义函数 单向查找 可以满足你的要求，你自己模仿一下改写代码就行

Sub 删除Word文档中没有数字的句子()
    Dim t
    Dim l, j, k As Long
    Dim str As String
    Dim rng As Range


    t = Timer
    k = 0
    Selection.HomeKey 6
    Do While 单向查找("[，；。]", True, True)
        j = Selection.Range.End
        CZ l, j
        Set rng = Selection.Range
        str = rng.Text
'        If 单向查找(" ", True, True) Then
            CZ l, j
            If Not 单向查找("[1-9]", True, True) Then
                If Not str = "与上次汇总数相比，" Then
                    rng.Font.ColorIndex = 6
                    k = k + 1
                End If
            End If
'        End If
        Selection.Collapse 0
        l = j
        CZ j, j
    Loop
    MsgBox "运行时间（s）：" & Timer - t & vbCr & "已经标记要删除的" & k & "句话！"
End Sub

Function 单向查找(文本, 通配符, 向下)
    Dim rng As Range

    With Selection.Find
        .ClearFormatting
        .Text = 文本
        .Forward = 向下
        .Wrap = wdFindStop '单向查找
'        wdFindContinue '往复查找
        .MatchWildcards = 通配符
        .Execute
        .Parent.Select
        单向查找 = .Found
    End With
End Function



Function CZ(l, j)
    Selection.SetRange Start:=l, End:=j
End Function