录了个查找代码，如何循环下去呢？

sblisb

如何循环查找全文时行操作呢？Sub Macro2()'
' Macro2 Macro
' 宏在 2015/10/30 由 sblisb 录制
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "A."
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveDown Unit:=wdParagraph, Count:=4, Extend:=wdExtend '向下四行

    '分为两栏
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
        InsertBreak Type:=wdSectionBreakContinuous
    Selection.Start = Selection.Start + 1
    ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
         Type:=wdSectionBreakContinuous
    With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
        .Width = CentimetersToPoints(6.95)
        .Spacing = CentimetersToPoints(0.75)
    End With
End Sub


能帮我简化一下代码吗？解决见6楼

413191246se

楼主，请说明白你的要求。

sblisb

413191246se 发表于 2015-10-31 10:14
楼主，请说明白你的要求。

代码只修改了第一个找到内容.如何修改查找到的所有内容.
分栏前如何根据所选中文字的字数长短来判断是分几栏?

413191246se

还是未明白，说得还是不清楚。你最好配图或附件。

sblisb

413191246se 发表于 2015-10-31 12:38
还是未明白，说得还是不清楚。你最好配图或附件。

新建 Microsoft Word 文档.zip (6.97 KB, 下载次数: 53)

2015-10-31 14:49 上传

点击文件名下载附件

见附件

山菊花

供参考：

1. Sub 分栏排列选择题答案()
   
2.     Dim Rng As Range, cTxt$, d%, nEnd%
   
3.     ActiveDocument.Range(0, 0).Select
   
4.     Selection.Find.ClearFormatting
   
5.     Selection.Find.Replacement.ClearFormatting
   
6.    
   
7.     With Selection.Find
   
8.         .Text = "^b"
   
9.         .Replacement.Text = ""
   
10.         .Forward = True
    
11.         .Wrap = wdFindContinue
    
12.         .Format = False
    
13.         .MatchCase = False
    
14.         .MatchWholeWord = False
    
15.         .MatchByte = True
    
16.         .MatchWildcards = False
    
17.         .MatchSoundsLike = False
    
18.         .MatchAllWordForms = False
    
19.     End With
    
20.     Selection.Find.Execute Replace:=wdReplaceAll
    
21.    
    
22.     ActiveDocument.Range.PageSetup.TextColumns.SetCount NumColumns:=1
    
23.    
    
24.     Selection.Find.Text = "A."
    
25.     On Error Resume Next
    
26.     Do
    
27.         ActiveDocument.Range(nEnd, nEnd).Select
    
28.         If Selection.Find.Execute = False Then Exit Do
    
29.         d = ActiveDocument.Range(0, Selection.Start).Paragraphs.Count
    
30.         nEnd = ActiveDocument.Paragraphs(d + 4).Range.End
    
31.         ActiveDocument.Range(Start:=nEnd, End:=nEnd).InsertBreak Type:=wdSectionBreakContinuous
    
32.         ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start).InsertBreak Type:=wdSectionBreakContinuous
    
33.         Set Rng = ActiveDocument.Range(Selection.Start + 1, nEnd)
    
34.         If Err <> 0 Then Exit Do
    
35.         cTxt = Rng.Text
    
36.         If Len(cTxt) < 65 Then
    
37.             Rng.PageSetup.TextColumns.SetCount NumColumns:=IIf(Len(cTxt) < 30, 4, 2)
    
38.         End If
    
39.     Loop
    
40. End Sub

复制代码

sblisb

山菊花 发表于 2015-10-31 17:04
供参考：

谢谢！
我这个是没有选择题的题目，怎么有题目时会引起格式混乱呀 test.zip (8.16 KB, 下载次数: 55)

2015-10-31 19:18 上传

点击文件名下载附件

山菊花

代码有修改。
把文档的“手动换行符”替换成“段落标记”，即按Ctrl+H，查找^l，替换为^p
再运行程序，看是否还有错误。

sblisb

山菊花 发表于 2015-10-31 19:37
代码有修改。
把文档的“手动换行符”替换成“段落标记”，即按Ctrl+H，查找^l，替换为^p
再运行程序，看 ...

不错，谢谢了
能不能再加一个字段长度超过65个字的不修改？

山菊花

代码修改见楼上。