修改批量设置下划线题号代码

geryjun

批量设置下划线题号代码已经在18楼，现在我想修改为 对选定内容进行操作，这样我可以在同一个页面对三种条件进行操作，不会对其他内容产生影响。

我看过类似的代码，但不会修改，请高手指教。

Selection.ParagraphFormat.TabStops.ClearAll
'基于选定内容的查找与替换
    Dim myFind() As Variant, myReplace As String
    Dim aArray As Variant, mySet As String, n As Integer, M As Integer
    Dim myRange As Range, myBk As Bookmark


------------------------------
在编辑试题时，常常要修改题号为       1             可是网上下载的一些文档有出现以下三种情况，如____1_____、    1     、1、
求助如何批量修改为统一格式，具体请见附件。谢谢

现在基本解决了，代码在18楼。谢谢 sqhsqhli  的提示：

现在根据10楼内容，录制了条件一的代码：但是测试时去不能实现加下划线的效果，求解。

1. 
   
2. Sub 条件1()
   
3. '
   
4. ' 文档中的多个连续的空格变成一个半角空格
   
5. '
   
6.     Selection.Find.ClearFormatting
   
7.     Selection.Find.Replacement.ClearFormatting
   
8.     With Selection.Find
   
9.         .Text = "^32{1,}"
   
10.         .Replacement.Text = "^32"
    
11.         .Forward = True
    
12.         .Wrap = wdFindContinue
    
13.         .Format = False
    
14.         .MatchCase = False
    
15.         .MatchWholeWord = False
    
16.         .MatchByte = False
    
17.         .MatchAllWordForms = False
    
18.         .MatchSoundsLike = False
    
19.         .MatchWildcards = True
    
20.     End With
    
21.     Selection.Find.Execute Replace:=wdReplaceAll
    
22.     Selection.Find.Execute Replace:=wdReplaceAll
    
23.     '除英文间的空格保留之外，其余多余的空格都被删除
    
24.     Selection.Find.ClearFormatting
    
25.     Selection.Find.Replacement.ClearFormatting
    
26.     With Selection.Find
    
27.         .Text = "([!a-zA-Z])( )([!a-z,A-Z])"
    
28.         .Replacement.Text = "\1\3"
    
29.         .Forward = True
    
30.         .Wrap = wdFindContinue
    
31.         .Format = False
    
32.         .MatchCase = False
    
33.         .MatchWholeWord = False
    
34.         .MatchByte = False
    
35.         .MatchAllWordForms = False
    
36.         .MatchSoundsLike = False
    
37.         .MatchWildcards = True
    
38.     End With
    
39.     '添加下划线
    
40.     Selection.Find.ClearFormatting
    
41.     Selection.Find.Replacement.ClearFormatting
    
42.     With Selection.Find
    
43.         .Text = "[0-9]{1,}"
    
44.         .Replacement.Text = "^32^&^32"
    
45.         .Forward = True
    
46.         .Wrap = wdFindContinue
    
47.         .Format = True
    
48.         .MatchCase = False
    
49.         .MatchWholeWord = False
    
50.         .MatchByte = False
    
51.         .MatchAllWordForms = False
    
52.         .MatchSoundsLike = False
    
53.         .MatchWildcards = True
    
54.     End With
    
55.     Selection.Find.Execute Replace:=wdReplaceAll
    
56. End Sub

复制代码

1. Sub 条件二()
   
2. '
   
3. ' 替换__ 为空格，转换为条件三格式
   
4. '
   
5.     Selection.Find.ClearFormatting
   
6.     Selection.Find.Replacement.ClearFormatting
   
7.     With Selection.Find
   
8.         .Text = "__"
   
9.         .Replacement.Text = " "
   
10.         .Forward = True
    
11.         .Wrap = wdFindContinue
    
12.         .Format = False
    
13.         .MatchCase = False
    
14.         .MatchWholeWord = False
    
15.         .MatchByte = False
    
16.         .MatchWildcards = False
    
17.         .MatchSoundsLike = False
    
18.         .MatchAllWordForms = False
    
19.     End With
    
20.     Selection.Find.Execute Replace:=wdReplaceAll
    
21.     Selection.Find.Execute Replace:=wdReplaceAll
    
22.     With Selection.Find
    
23.         .Text = "_"
    
24.         .Replacement.Text = " "
    
25.         .Forward = True
    
26.         .Wrap = wdFindContinue
    
27.         .Format = False
    
28.         .MatchCase = False
    
29.         .MatchWholeWord = False
    
30.         .MatchByte = False
    
31.         .MatchWildcards = False
    
32.         .MatchSoundsLike = False
    
33.         .MatchAllWordForms = False
    
34.     End With
    
35.     Selection.Find.Execute
    
36.     Selection.Find.Execute Replace:=wdReplaceAll
    
37.     Selection.Find.Execute Replace:=wdReplaceAll
    
38. End Sub
    

复制代码

现在的关键就是条件一的最后下划线可以实现的话，其他问题都可以解决。






附件内容如下：（内容来自于网络，内容没有任何意义，只是做演示。） 新建 Microsoft Word 文档.zip (4.15 KB, 下载次数: 34)

2012-5-8 13:13 上传

点击文件名下载附件

条件一：

中广网北京5月8日消息   据   1   经济之声《天下财经》报道，通化  2   金马昨天晚间发布公告，公司  3   又有两个批号的胶囊产品  4   被查出铬超标，胶囊的  5   来源来自早前已被曝光的问题供  6   应商华星胶丸厂。目前，  7   问题胶囊已全都  8   流入市场，通化金马将组  9   织召回和销毁。此前通化金马一  10   度宣  11   称除临时从  12   卓康胶囊厂购  13   进胶囊外，没  14   有再向其他被曝光的问  15   题供应商采购。

条件二

中广网北京5月8日消息   据 ____1_____ 经济之声《天下财经》报道，通化____2____金马昨天晚间发布公告，公司____3____又有两个批号的胶囊产品____4____被查出铬超标，胶囊的____5____来源来自早前已被曝光的问题供____6____应商华星胶丸厂。目前，____7____问题胶囊已全都____8____流入市场，通化金马将组____9____织召回和销毁。此前通化金马一____10____度宣____11____ 称除临时从____12____卓康胶囊厂购____13____进胶囊外，没____14____有再向其他被曝光的问____15____题供应商采购。

条件三

中广网北京5月8日消息   据 1 经济之声《天下财经》报道，通化 2 金马昨天晚间发布公告，公司 3又有两个批号的胶囊产品4被查出铬超标，胶囊的5来源来自早前已被曝光的问题供6应商华星胶丸厂。目前，7 问题胶囊已全都8 流入市场，通化金马将组9 织召回和销毁。此前通化金马一10 度宣11 称除临时从12 卓康胶囊厂购13 进胶囊外，没14 有再向其他被曝光的问15 题供应商采购。

最终效果：

中广网北京5月8日消息   据   1   经济之声《天下财经》报道，通化  2   金马昨天晚间发布公告，公司  3   又有两个批号的胶囊产品  4   被查出铬超标，胶囊的  5   来源来自早前已被曝光的问题供  6   应商华星胶丸厂。目前，  7   问题胶囊已全都  8   流入市场，通化金马将组  9   织召回和销毁。此前通化金马一  10   度宣  11   称除临时从  12   卓康胶囊厂购  13   进胶囊外，没  14   有再向其他被曝光的问  15   题供应商采购。

geryjun

没人回复呀。
下载文档次数也少。

geryjun

首先应该是删除空白、删除________（不是下下划线），然后才是替换。

geryjun

自己顶一下。

szh9388

也想知道，顶你一下

geryjun

szh9388 发表于 2012-5-9 15:54
也想知道，顶你一下

谢谢。同顶。

wudixin96

因为不完全是数字加下划线，还要考虑日期里的数字不要加下划线，这个有难度 的。

wudixin96

除非写VBA代码进行逐个判断差不多。

geryjun

wudixin96 发表于 2012-5-9 16:53
因为不完全是数字加下划线，还要考虑日期里的数字不要加下划线，这个有难度 的。

这个可以不考虑先，如果有就手动操作。

geryjun

已经有了思路，还没有录制宏，
第一步、先把条件一用去除空格的方法 条件二用替换__ 为空格  这样条件一和条件二都会变成了条件三。
第二步、使用通配符替换成功。

参考页面为： http://zshunj.cn/article/1798.html