急急急，如何实现这样的批量替换？？？

xzb1972

谢谢，但是没有解决问题

xzb1972

413191246se 发表于 2012-4-6 11:21
似乎达到了目的，楼主不妨用用看！大部分是用 VBA 宏代码，略微用查找与替换。
附件：

谢谢，怎么文件里没有VBA代码呀？

413191246se

楼主，这是4年前的帖子，另外，原来的文件已经做好了，不需要代码。——你还需要代码吗？

413191246se

1. Sub 第一章()
   
2.     Dim i As Paragraph, j As String, k As Long, s As Long
   
3.     j = InputBox("请输入[章/条/节/课/题/部分/自然段]等量词！", "第一章/第1章/条/节/课/题/部分/自然段", "章")
   
4.     If j = "" Then Exit Sub
   
5.     If MsgBox("是：<居中/副标题>格式    否：<普通加粗>格式", vbYesNo + vbExclamation, "请选择设置[第一" & j & "]的格式！") = vbYes Then k = 1 Else k = 2
   
6.     For Each i In ActiveDocument.Paragraphs
   
7.         If i.Range Like "第[一二三四五六七八九十]" & j & "*" Or i.Range Like "第[一二三四五六七八九十][一二三四五六七八九十百]" & j & "*" Or i.Range Like "第[二三四五六七八九]十[一二三四五六七八九]" & j & "*" Or i.Range Like "第[一二三四五六七八九]百[一二三四五六七八九零][一二三四五六七八九十]" & j & "*" Or i.Range Like "第[一二三四五六七八九]百[一二三四五六七八九]十[一二三四五六七八九]" & j & "*" Or i.Range Like "第#" & j & "*" Or i.Range Like "第##" & j & "*" Or i.Range Like "第###" & j & "*" Or i.Range Like "第####" & j & "*" Then
   
8.             i.Range.Find.Execute FindText:="　", replacewith:="", Replace:=wdReplaceAll
   
9.             i.Range.Find.Execute FindText:="^w", replacewith:="", Replace:=wdReplaceAll
   
10.             s = InStr(i.Range, j)
    
11.             If Len(j) = 1 Then
    
12.                 i.Range.Characters(s).InsertAfter Text:="　"
    
13.             Else
    
14.                 i.Range.Characters(s + Len(j) - 1).InsertAfter Text:="　"
    
15.             End If
    
16.             If k = 1 Then
    
17.                 If Len(j) = 1 Then
    
18.                     If Len(i.Range) - s - 2 = 2 Then i.Range.Characters(s + 2).InsertAfter Text:="　"
    
19.                 Else
    
20.                     If Len(i.Range) - s - Len(j) - 1 = 2 Then i.Range.Characters(s + Len(j) + 1).InsertAfter Text:="　"
    
21.                 End If
    
22.                 With i.Range
    
23.                     .Style = wdStyleSubtitle
    
24.                     With .Font
    
25.                         .Name = "黑体"
    
26.                         .Name = "Arial"
    
27.                         .Color = wdColorRed '红色
    
28.                     End With
    
29.                     With .ParagraphFormat
    
30.                         .SpaceBefore = 24
    
31.                         .SpaceAfter = 18
    
32.                         .AutoAdjustRightIndent = False
    
33.                         .DisableLineHeightGrid = True
    
34.                     End With
    
35.                 End With
    
36.             Else
    
37.                 If Len(j) <> 1 Then s = s + Len(j) - 1
    
38.                 With ActiveDocument.Range(Start:=i.Range.Start, End:=i.Range.Characters(s).End).Font
    
39.                     .Name = "黑体"
    
40.                     .Name = "Times New Roman"
    
41.                     .Bold = True
    
42.                     .Color = wdColorBlue '蓝色
    
43.                 End With
    
44.             End If
    
45.         End If
    
46.     Next
    
47.     MsgBox "处理完毕！", vbOKOnly + vbExclamation, "第一章/第1章/条/节/课/题/部分/自然段"
    
48. End Sub

复制代码

xzb1972

413191246se 发表于 2016-3-22 16:12
楼主，这是4年前的帖子，另外，原来的文件已经做好了，不需要代码。——你还需要代码吗？

是的，需要代码，因为有好多这样的文档需要转换呢。

xzb1972

413191246se 发表于 2016-3-22 16:14

太好了，太感谢了。我得好好学习一下子。

xzb1972

413191246se 发表于 2016-3-22 16:14

太好了，太感谢了。我得好好学习一下子

gbgbxgb

很奇怪，帖子明明说的是要替换汉字“第一条”为数字的“第1条”，且设为“黑体”和“加粗”，何以楼主说前面楼层的代码“太好了”，莫名其妙。

上个图，“到此一游”，留个念，帮顶：

13907933959

413191246se 发表于 2016-3-22 16:14

师傅好！
运行该宏后，好像并未把第一条”、“第二条”……，替换为“第1条　”、“第2条　”……
还是原来的第一条”、“第二条”……，只是把它们加粗和变色了。
如要替换为“第1条　”、“第2条　”……代码该如何修正？

413191246se

1. Sub test()
   
2. '第一条转第1条
   
3. 'Sub 删除所有空格()
   
4.     Dim myRange As Range
   
5.     If Selection.Type = wdSelectionIP Then Selection.WholeStory
   
6.     Set myRange = Selection.Range
   
7.     myRange.Find.Execute FindText:="　", replacewith:="", Replace:=wdReplaceAll    '删除所有全角空格
   
8.     myRange.Find.Execute FindText:="^w", replacewith:="", Replace:=wdReplaceAll    '删除所有空白区域
   
9. 
   
10.     '选定字符间循环--选定字符字长=v，循环次数=i
    
11.     Dim v As Long, i As Long
    
12.     Selection.HomeKey Unit:=wdStory
    
13.     Selection.Find.ClearFormatting
    
14.     Do While Selection.Find.Execute(FindText:="第", Forward:=True)
    
15.         Do
    
16.             Selection.MoveEnd Unit:=wdCharacter, Count:=1
    
17.         Loop Until Selection Like "*[!一二三四五六七八九十百零]"
    
18.         
    
19.         If Selection Like "*条" Then
    
20.             Selection.MoveStart Unit:=wdCharacter, Count:=1
    
21.             Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
22.             Selection.Font.Color = wdColorRed
    
23.             
    
24.             '十一到十九
    
25.             If Selection Like "十[一二三四五六七八九]" Then
    
26.                 Selection.Characters(1) = "1"
    
27.                 Selection.MoveRight Unit:=wdCharacter, Count:=1
    
28.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
29.                 GoTo Sec
    
30.             
    
31.             '二十到九十，一百到九百
    
32.             ElseIf Selection Like "[一二三四五六七八九][十百]" Then
    
33.                 If Selection Like "*十" Then Selection.Characters(2) = "0" Else Selection.Characters(2) = "00"
    
34.                 Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
35.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
36.                 GoTo Sec
    
37.                
    
38.             '第一百二十条
    
39.             ElseIf Selection Like "???十" Then
    
40.                 Selection.Characters.Last = "0"
    
41.             End If
    
42.             
    
43.             Selection = Replace(Selection, "百", "")
    
44.             If Len(Selection) >= 3 Then Selection = Replace(Selection, "十", "")
    
45.             
    
46.             v = Len(Selection)
    
47.             Selection.MoveLeft Unit:=wdCharacter, Count:=1
    
48.             Do
    
49.                 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
50. Sec:
    
51.                 If Selection = "一" Then
    
52.                     Selection = "1"
    
53.                 ElseIf Selection = "二" Then
    
54.                     Selection = "2"
    
55.                 ElseIf Selection = "三" Then
    
56.                     Selection = "3"
    
57.                 ElseIf Selection = "四" Then
    
58.                     Selection = "4"
    
59.                 ElseIf Selection = "五" Then
    
60.                     Selection = "5"
    
61.                 ElseIf Selection = "六" Then
    
62.                     Selection = "6"
    
63.                 ElseIf Selection = "七" Then
    
64.                     Selection = "7"
    
65.                 ElseIf Selection = "八" Then
    
66.                     Selection = "8"
    
67.                 ElseIf Selection = "九" Then
    
68.                     Selection = "9"
    
69.                 ElseIf Selection = "十" Then
    
70.                     Selection = "10"
    
71.                 ElseIf Selection = "百" Then
    
72.                     Selection = "佰"
    
73.                 ElseIf Selection = "零" Then
    
74.                     Selection = "0"
    
75.                 End If
    
76. 
    
77.                 Selection.MoveRight Unit:=wdCharacter, Count:=1
    
78.                 i = i + 1
    
79.             Loop Until i = v
    
80.         End If
    
81.         Selection.MoveRight Unit:=wdCharacter, Count:=1
    
82.         i = 0
    
83.     Loop
    
84.     MsgBox "处理完毕！——下面请自行执行【第一章/条】宏完成第1条加粗任务！", vbOKOnly + vbExclamation, "第一条转第1条"
    
85. End Sub

复制代码