谢谢守柔斑竹，我的问题圆满解决，贴上我的程序

ying

非常感谢守斑竹，我的问题在你和大家的帮助下已经圆满解决，下面是相应的程序。后来我问的几个问题都是跟解决着个问题有关。不过现在还是按守斑竹的程序思路才解决了问题。十分感谢。希望守斑竹有时间能给我们讲讲word中常用的简单对象的知识。再次3Q.

Sub workying() ' ' workying Macro ' 宏在 2005-8-13 由 king 创建 'Sub datwork() Dim MyKeyText() As Variant, i As Paragraph, n As Long, m As Long, flag As Byte MyKeyText() = Array("Official Symbol", "Name", "Other Aliases", "Other Designations", "Chromosome", "Location", "GeneID") Set doc = ActiveDocument Application.ScreenUpdating = False '关闭屏幕刷新

'===========================去掉and 给Name换行 With doc.Content.Find .ClearFormatting .Text = "and " .Replacement.ClearFormatting .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue

End With '===========================给Location换行 With doc.Content.Find .ClearFormatting .Text = "Location" .Replacement.ClearFormatting .Replacement.Text = "^pLocation" .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With '===========================去掉所有空行 For Each i In doc.Paragraphs '在活动文档的段落集合中循环 If Len(i.Range) = 1 Then '判断段落长段,此处可根据文档实际情况 i.Range.Delete '进行必要的修改可将任意长度段落删除 End If Next '=========================== '===========================

For Each i In ActiveDocument.Paragraphs '在活动文档的段落集合中循环 flag = 0 If VBA.InStr(i.Range, "Links") <> 0 Then 'i.Range.InsertBefore Chr(13) n = -1 m = m + 1 flag = 1 End If Do While (flag = 0) And (n < 6) n = n + 1 If (VBA.InStr(i.Range, MyKeyText(n)) = 0) And ((n <> 1) Or (VBA.InStr(i.Range, "similar") = 0)) Then i.Range.InsertBefore Chr(13) Else Exit Do End If Loop Next '=========================== '=========================== 'MsgBox "共有" & m & "个数据!" Application.ScreenUpdating = True '恢复屏幕刷新 End Sub

守柔

好，写得不错，也很规范！

建议由于空白段落也可以使用查找与替换的方式（通常需要三次以上替换，即"^p^p"替换为"^p"），加之你本来有两个查找与替换，可以考虑使用写个循环的方法，也是使用数组，这对于大文档，特别有用。也就是说查找与替换法删除空白段落，在长文档中，比在段落中循环更快。