求大佬指点!!!如何改善word中这段VBA代码

谬35 2024-11-30 16:40:42

想实现的功能是:在文档中查找到类似“同比增加XXX万/亿”的表述都自动标红,目前这段代码只能实现“同比增加XXX”标红,无法将单位“万/亿”一起标红,问了ai一直解决不了,求大佬指教!

示例文本:

同比增加2222万,同比增加11万,同比增加111万,同比减少234万,同比增加1亿,同比增加0.16亿

同比增加2亿,同比增加1.23亿,同比增加1500万,同比减少23万 ,同比增加235亿

同比增加500万,显示出良好的增长趋势。

同比增加1.5亿,这对公司来说是一个重大里程碑

使用的版本是:WPS 12.1.0.18912

代码如下:

Sub Highlight同比增加()
    Dim oRange As Range
    Dim found As Boolean
    Dim startPos As Long
    Dim endPos As Long
    Dim searchText As String
    Dim char As String
    
    ' 设置查找文本
    searchText = "同比增加"
    
    ' 获取文档内容范围
    Set oRange = ActiveDocument.Content
    
    ' 查找“同比增加”
    With oRange.Find
        .Text = searchText & "*"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWildcards = True
    End With
    
    ' 开始查找
    found = oRange.Find.Execute
    
    ' 循环查找并标红
    Do While found
        ' 获取当前找到的位置
        startPos = oRange.Start
        endPos = oRange.End
        
        ' 扩展范围到包含数字和单位
        Do
            char = Mid(ActiveDocument.Content.Text, endPos + 1, 1)
            If char Like "[0-9.]" Or char = "万" Or char = "亿" Then
               endPos = endPos + 1
           Else
               Exit Do
           End If
        Loop
        
        ' 标红完整范围
        oRange.SetRange Start:=startPos, End:=endPos - 1
        oRange.Font.Color = RGB(255, 0, 0)
        
        ' 移动到下一个搜索位置
        oRange.Start = endPos + 1
        found = oRange.Find.Execute
    Loop
End
    
    ' 提示完成
    MsgBox "已成功标红所有相关内容!", vbInformation
End Sub
 

...全文
69 回复 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

5,172

社区成员

发帖
与我相关
我的任务
社区描述
其他开发语言 Office开发/ VBA
社区管理员
  • Office开发/ VBA社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧