如何一次性替换所有空行（广义上的）！

konggs

分享并求教：
分享：以下宏是去掉空行及段前段后的空格及制表位的宏！
同时也就是山地步兵兄所说的广义空格及广义空行的替换方法。
――――――――――――

Sub 高级替换() '复制以下三个宏，第一个是主宏，运行她即可
Debug.Print Timer
Application.ScreenUpdating = False
On Error Resume Next '忽略错误
Selection.HomeKey Unit:=wdStory '光标放到最前
With Dialogs(wdDialogEditReplace)
.Find = "[^l^13][^l, ,　, ,?,?^t,^13]{1,}"
.Replace = "^p"
.PatternMatch = True '勾选通配符
.Format = False '去除格式
.ReplaceAll = True '全部替换
.Execute
End With
开始段判断
最后段判断
Selection.HomeKey Unit:=wdStory '光标放到最前
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
Sub 开始段判断()
ActiveDocument.Paragraphs(1).Range.Select
With Dialogs(wdDialogEditReplace)
.Find = "[, ,　, ,^t]{1,}"
.Replace = ""
.PatternMatch = True '勾选通配符
.Format = False '去除格式
.ReplaceAll = True '全部替换
.Execute
End With
'Selection.Delete
ActiveDocument.Paragraphs.Last.Range.Select
With Dialogs(wdDialogEditReplace)
.Find = "[, ,　, ,?,?^t]{1,}"
.Replace = ""
.PatternMatch = True '勾选通配符
.Format = False '去除格式
.ReplaceAll = True '全部替换
.Execute
End With
'Selection.Delete
End Sub
Sub 最后段判断()
If Len(ActiveDocument.Paragraphs.Last.Range) = 1 Then
ActiveDocument.Paragraphs.Last.Range.Delete
End If
If Len(ActiveDocument.Paragraphs(1).Range) = 1 Then
ActiveDocument.Paragraphs(1).Range.Delete
End If
ActiveDocument.Paragraphs.Last.Range.Select
With Dialogs(wdDialogEditReplace)
.Find = "[ ,　, ,?,?^t,]{1,}^13"
.Replace = ""
.Format = False '去除格式
.ReplaceAll = True '全部替换
.Execute
End With
End Sub
――――――――――――
请教老大：
第一，为什么我在插入/符号/特殊符号找到的“半角空格”与“全角空格”复制到VBA下，变成了上面的“?,?”。
第二，此程序我觉得太大了点，应该可以简练一些，望老大指点一下。

同时希望大家踊跃测试，而后由老大完善（我的能力到此为止了）。

[此贴子已经被作者于2005-11-29 21:32:15编辑过]

守柔

TO KONGGS兄：

第一，关于问号字符，其实就是VBA中不支持的符号，各种不同的符号使用范围由特定的代码页所决定，你不可能在代码窗口中插入图形或者域一样的道理。

第二，我整理的代码，未经特别认真的测试，还是由你这个“始作俑者”完成吧，有问题，可以交流。

第三，大部分的含义和意图我在代码中写得已经很清楚了，有些问题，你通过看代码，能比较出你原代码中的错误、问题和协调性不好的问题。

第四，我在你基础上适当作了些丰富，你看一下，是否需要或者调整其实内容。

第五，这是你首次写的目标比较明确的较长的代码，尽管走了些弯路，还是祝贺你，为你喝彩！不错，希望以后写得更好！

******************************

Option Explicit
Sub 高级替换()
'本程序主要用于网页下载后的文本处理,它是一个超级替换,
'可以删除空白段落\空白手动换行符,全半角空格和全半角不间断空格
'本程序由KONNGS提供,Shourou整理
Dim i As Byte, myFindText As String, TF As Boolean, myReplaceWith As String
Dim MyRange As Range
Application.ScreenUpdating = False '关闭屏幕更新,加快程序运行
With ActiveDocument
For i = 1 To 5 '建立一个五次查找与替换的循环
Select Case i
Case 1
Set MyRange = .Content '主文档文字部分中搜索以手动换行符或者段落标记开头的至少一个以上(255以下)
'换行符\全半角空格制表位和段落标记的表达式
myFindText = "[^l,^13][^l, ,　,^t,^13]{1,}"
TF = True '使用通配符
myReplaceWith = "^p" '替换为段落标记
Case 2
Set MyRange = .Content.Paragraphs.First.Range '定义MyRange 为文档第一个段落
myFindText = "[ ,　,^t]{1,}" '在第一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "" '替换为空空,即删除
Case 3
Set MyRange = .Content.Paragraphs.Last.Range '定义MyRange为文档最后一个段落
myFindText = "[ ,　,^t]{1,}" '在最后一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "" '替换为空空,即删除
Case 4
Set MyRange = .Content '定义MyRange 为主文档文字部分
myFindText = "^u8194" '不间断半角空格
TF = False '不使用通配符
myReplaceWith = "" '删除
Case 5
Set MyRange = .Content '定义MyRange 为主文档文字部分
myFindText = "^u8195" '不间断全角空格
TF = False '不使用通配符
myReplaceWith = "" '删除
End Select
With MyRange.Find '指定区域范围中的查找与替换
.ClearFormatting '清除格式
.MatchWildcards = TF
.Text = myFindText
.Execute replacewith:=myReplaceWith, Replace:=wdReplaceAll '根据定义进行全部替换
End With
'如果末段和首段为空白段落,则删除之,这段落代码之所以放在循环中,是因为如果在循环前删除,有可能仍然会出现单个空白段落
If Len(.Content.Paragraphs.Last.Range) = 1 Then .Content.Paragraphs.Last.Range.Delete
If Len(.Content.Paragraphs.First.Range) = 1 Then .Content.Paragraphs.First.Range.Delete
Next i
.Content.ParagraphFormat.CharacterUnitFirstLineIndent = 2 '主文档段落首行缩进2字符
End With
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

[此贴子已经被作者于2005-11-30 5:59:14编辑过]

konggs

老大的代码可读性强，简练多了。[em17][em17][em17]

谢谢老大的鼓励！

————————————
我觉得：还有两点需要完善。

第一：（否则，把最后一段的文字内的空格与制表符等也去掉了）
在last中的代码：
myFindText = "[ ,　,^t]{1,}" '在最后一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "" '替换为空空,即删除

我觉得应该改：
myFindText = "[ ,　,^t]{1,}^13"
TF = True '使用通配符
myReplaceWith = "^p" '替换为空空,即删除

第二：
在first中的
myFindText = "[ ,　,^t]{1,}" '在最后一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "" '替换为空空,即删除

我觉得应该：
先判断第一个.Characters.First是否为空格、制表符等几个符号，是的话，只执行一次。（否则，把最后一段的文字内的空格与制表符等也去掉了）
myFindText = "[ ,　,^t]{1,}" '在第一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "" '替换为空空,即删除

－－－－－
老大，以为呢？

[此贴子已经被作者于2005-11-30 8:38:45编辑过]

konggs

这是我的判断第一行的代码

Sub 判断替换第一行()
Dim MyRange, pan, x%
x = 0
With ActiveDocument
pan = .Characters.First
Set MyRange = .Paragraphs.First.Range
If pan = " " Or pan = "　" Or AscW(pan) = "160" Or AscW(pan) = "9" Then

With MyRange.Find '指定区域范围中的查找与替换
.ClearFormatting '清除格式
.MatchWildcards = True
.Text = "[ ,　, ,^t]{1,}"
.Execute replacewith:="", Replace:=wdReplaceOne '根据定义进行全部替换
End With
End If
End With
End Sub

konggs

2005年11有30日的最后结果：

Sub 超级替换()
'本程序主要用于网页下载后的文本处理,它是一个超级替换,
'可以删除空白段落\空白手动换行符,全半角空格和全半角不间断空格
'本程序由KONNGS提供,Shourou整理
Dim i As Byte, myFindText As String, TF As Boolean, myReplaceWith As String
Dim MyRange As Range, pan
Application.ScreenUpdating = False '关闭屏幕更新,加快程序运行
With ActiveDocument
For i = 1 To 6 '建立一个六次查找与替换的循环
Select Case i
Case 1
Set MyRange = .Content '主文档文字部分中搜索以手动换行符或者段落标记开头的至少一个以上(255以下)
'换行符\全半角空格制表位和段落标记的表达式
myFindText = "[^l,^13][^l, ,　,^s,^t,^13]{1,}"
TF = True '使用通配符
myReplaceWith = "^p" '替换为段落标记
Case 2
Set MyRange = .Content '主文档文字部分中搜索以动换行符或者段落标记结束的前有空格的
'换行符\全半角空格制表位和段落标记的表达式
myFindText = "[ ,　,^s,^t]{1,}[^l^13]"
TF = True '使用通配符
myReplaceWith = "^p" '替换为段落标记
Case 3
Set MyRange = .Content '主文档文字部分中搜索换行符替换为段落标记
'换行符\全半角空格制表位和段落标记的表达式
myFindText = "^l"
TF = True '使用通配符
myReplaceWith = "^p" '替换为段落标记
Case 4
Set MyRange = .Content.Paragraphs.Last.Range '定义MyRange为文档最后一个段落
myFindText = "[ ,　,^t]{1,}^13" '在最后一个段落中查找至少一个以上的全半角空格或者制表位的表达式
TF = True '使用通配符
myReplaceWith = "^p" '替换为空空,即删除
Case 5
Set MyRange = .Content '定义MyRange 为主文档文字部分
myFindText = "^u8194" '不间断半角空格
TF = False '不使用通配符
myReplaceWith = "" '删除
Case 6
Set MyRange = .Content '定义MyRange 为主文档文字部分
myFindText = "^u8195" '不间断全角空格
TF = False '不使用通配符
myReplaceWith = "" '删除
End Select
With MyRange.Find '指定区域范围中的查找与替换
.ClearFormatting '清除格式
.MatchWildcards = TF
.Text = myFindText
.Execute replacewith:=myReplaceWith, Replace:=wdReplaceAll '根据定义进行全部替换
End With
'如果末段和首段为空白段落,则删除之,这段落代码之所以放在循环中,是因为如果在循环前删除,有可能仍然会出现单个空白段落
If Len(.Content.Paragraphs.Last.Range) = 1 Then .Content.Paragraphs.Last.Range.Delete
If Len(.Content.Paragraphs.First.Range) = 1 Then .Content.Paragraphs.First.Range.Delete
Next i
.Content.ParagraphFormat.CharacterUnitFirstLineIndent = 2 '主文档段落首行缩进2字符
End With
判断替换第一行
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
Sub 判断替换第一行()
Dim MyRange, pan, x%
x = 0
With ActiveDocument
pan = .Characters.First
Set MyRange = .Paragraphs.First.Range
If pan = " " Or pan = "　" Or AscW(pan) = "160" Or AscW(pan) = "9" Then '如果第一字是半角空格，全角空格，不间断空格或制表符则在
With MyRange.Find '指定区域范围中的查找与替换
.ClearFormatting '清除格式
.MatchWildcards = True
.Text = "[　, ,^t,^s]{1,}"
.Execute replacewith:="", Replace:=wdReplaceOne '根据定义进行全部替换
End With
End If
End With
End Sub

[此贴子已经被作者于2005-11-30 19:23:50编辑过]

youyou300

孔老弟，告诉我如何导入以上的宏的内容？

konggs

传个模板，以便测试。

使用方法：工具栏上点超级替换（注：把宏安全性设为中或低）

P9PpyYvz.rar (9.94 KB, 下载次数: 22)

2005-11-30 19:41 上传

点击文件名下载附件

[此贴子已经被作者于2005-11-30 19:41:39编辑过]