ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: gemj

一个小难题:单词修复-去中间不该有的空格

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 14:56 | 显示全部楼层
sylun大哥好酷哦!先谢过,再测试!!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 15:08 | 显示全部楼层

运行到这里的时候,出了点问题,要求调试:

While Not (.Words(2).Next Is Nothing)

我的文档很长,1千多页,呵呵。

运行时我观察了一下,出问题之前应该是更正不少错误了!

再次感谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 15:12 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
用我发的这个附件测试,结果非常完美!

TA的精华主题

TA的得分主题

发表于 2007-3-26 15:51 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
QUOTE:
以下是引用gemj在2007-3-26 15:08:57的发言:

运行到这里的时候,出了点问题,要求调试:

While Not (.Words(2).Next Is Nothing)

我的文档很长,1千多页,呵呵。

运行时我观察了一下,出问题之前应该是更正不少错误了!

再次感谢!

我也知道还存在些问题,主要包括:如标为错误的word前面有两个以上的空格,则只能与最近的一个空格(实为一个字符)合并;如文档第一个word是错误的,则不能与其下一个word合并。但测试并未发现所提及的错误。水平所限,加上没有样本,不好测试。
我用楼主提及那句代码当时主要意图是想避免出现运行至文档末尾而最后一个word恰好又是一个错误时而导致程序出错的,但对此语句理解得不够透切。
请试将代码.SetRange Start:=.Words(1).Previous.Start, End:=.End改为如下代码后再作测试(好像可解决第一个问题),谢谢。
.SetRange Start:=.Words(1).Previous(wdWord).Start, End:=.End

[此贴子已经被作者于2007-3-26 15:57:50编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 16:01 | 显示全部楼层
QUOTE:
以下是引用sylun在2007-3-26 15:51:41的发言:

我也知道还存在些问题,主要包括:如标为错误的word前面有两个以上的空格,则只能与最近的一个空格(实为一个字符)合并;如文档第一个word是错误的,则不能与其下一个word合并。但测试并未发现所提及的错误。水平所限,加上没有样本,不好测试。
请试将代码.SetRange Start:=.Words(1).Previous.Start, End:=.End改为如下代码后再作测试(好像可解决第一个问题),谢谢。
.SetRange Start:=.Words(1).Previous(wdWord).Start, End:=.End

sylun大哥实在严谨!佩服之极!

现抽取文档中的一部分,程序运行前后的情况各保存一份,都传上来,供大哥测试,再次感谢!SYLUN大哥应该当版主了,呵呵!

运行前:

sEWFCSjd.rar (26.38 KB, 下载次数: 8)

 



lKvfmKvG.rar

25.68 KB, 下载次数: 7

一个小难题:单词修复-去中间不该有的空格

TA的精华主题

TA的得分主题

发表于 2007-3-26 17:09 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

楼主太抬举我了。我只是想借您的题来练习VBA而已,刚学了一点VBA的操作,还是一知半解的,水平十分有限,与版主们是不可相提并论的,水平离他们还远着呢。

刚才对两个附件进行过测试,都可以通过,其中第一个发现103个错误,尝试更正了67个。第二个发现20个,更正1个。只是第一个更正与第二个发现合计才87个,而不是103,不知何解,也许存在两个错合并后变成o。可能楼主的测试环境与我的不同。

[此贴子已经被作者于2007-3-26 17:25:56编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 19:01 | 显示全部楼层

水平这么高还这么谦虚,这就很难得了,呵呵!

更正的个数我的理解可能是我的WORD在使用的过程中,添加了一些单词到词典里了,所以有些单词被我的WORD认为是正确的了,呵呵!

我是WIN2003,OFFICE2003英文版加装中文语言包。

TA的精华主题

TA的得分主题

 楼主| 发表于 2007-3-26 23:33 | 显示全部楼层
ClS7vZTu.rar (2.91 KB, 下载次数: 9)

当运行到下面的三处时,均出现需要调试的提示。

也就是,在错误单词的前面不能有双引号;在错误单词的后面不能有单引号,这是何故呢?

40.   The United States sales manager calls the new watch “kidproof” because ________.

31.   It can be learned from the passage that the Ouchidas’ house ________.

C) The woman is a friend of the Stevensons’.

我把这类双引号和单引号先都隐藏起来,再运行,结果非常完美!

对被更改的单词,除了极少数如AA这样的情况外,几乎没有别的不该发生的错误。这说明,这种思路是可行的。

再次衷心感谢SYLUN,你让我的生活变得更加轻松,更加美好!

TA的精华主题

TA的得分主题

发表于 2007-3-27 01:28 | 显示全部楼层

刚才测试,确实存在楼主所说的问题。经反复观察,发现原因奇特:
对有双引号的那个错误,当程序运行至删除错误区域的空格(即replace函数,此时实际没有空格)时,前引号奇怪地变成了宋体字符,并导致word认为错误区域不存在第2个word,因而产生运行错误。如果将所有replace函数添加执行条件If InStr(.Text, Chr(32)) > 0 Then...,则好像可以避免此错误。

对于后面两个错误,情况也是修改后错误区域中的word始终为1个,而且执行中以Debug.Print .Text & .Words(1)在立即窗口显示的两者字符并不合理(后都的字符在前者中找不到),无法理解,也不知如何避免此错误。当然,在前面加上on error resume next好像还可以。

也许有其他好办法。

TA的精华主题

TA的得分主题

发表于 2007-3-27 11:22 | 显示全部楼层

继续修改,希望避免更正无效并复原时可能出现多添加空格的情形,并加了纠错语句,但好像不用纠错语句对18楼的附件也可通过。请再作测试
Sub correct_err()
'
    Dim myRange As Range, myErrors As Variant, myerr As Range
    Dim n As Integer, c As Integer, errtxt As String, b As Boolean
    
    On Error Resume Next
    Set myErrors = ThisDocument.Range.SpellingErrors
    n = myErrors.Count
    For Each myerr In myErrors
        Set myRange = myerr
        errtxt = myerr.Text
        b = False
        With myRange
            '先尝试与前一word合并
            While Not (.Words(1).Previous Is Nothing)
                .SetRange Start:=.Words(1).Previous(wdWord).Start, End:=.End
                If InStr(.Text, "’") > 0 Then      '此处引号内的符号为中文标点’
                    .SetRange Start:=.Words(1).Previous(wdWord,2).Start, End:=.End
                End If
                If InStr(.Text, Chr(32)) > 0 Then
                    b = True
                    .Text = Replace(.Text, Chr(32), "")
                End If
                .HighlightColorIndex = wdYellow
                c = c + 1
                '如果仍有错,则复原并与后一word合并
                If .SpellingErrors.Count > 0 Then
                    If b = True Then
                        .Text = Replace(.Text, errtxt, Chr(32) & errtxt, 1)
                        b = False
                    End If
                    .HighlightColorIndex = wdNoHighlight
                    c = c - 1
                    If .Words.Count > 1 Then
                    While Not (.Words(2).Next Is Nothing)
                        .SetRange Start:=.Words(2).Start, End:=.Words(2).Next.End
                        If InStr(.Text, Chr(32)) > 0 Then
                            b = True
                            .Text = Replace(.Text, Chr(32), "")
                        End If
                        .Select
                        .HighlightColorIndex = wdYellow
                        c = c + 1
                        '如果错误仍未消除,则复原
                        If .SpellingErrors.Count > 0 Then
                            If b = True Then
                                .Text = Replace(.Text, errtxt, errtxt & Chr(32), 1)
                                b = False
                            End If
                            .HighlightColorIndex = wdNoHighlight
                            c = c - 1
                        End If
                        GoTo NF
                    Wend
                    Else
                   
                    End If
                End If
                GoTo NF
            Wend
        End With
NF: Next myerr
    MsgBox "共发现" & n & "个错误,并尝试更正了" & c & "个(突出显示部分)。", vbInformation
End Sub

[此贴子已经被作者于2007-3-27 17:38:52编辑过]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-28 10:48 , Processed in 0.052651 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表