删除文档最后一个字符，后面的空格与回车（即无意义的空格和回车）

学习VS交流

loquat 发表于 2015-1-22 21:33

附件二.rar (7.86 KB, 下载次数: 6)

2015-1-22 21:57 上传

点击文件名下载附件

老师感谢你的代码，但运行有错

测试这个附件就知道了

会删除　最后的　“测　　试”

loquat

原因不清楚，待我问问高人

学习VS交流

loquat 发表于 2015-1-22 22:34
原因不清楚，待我问问高人

谢谢老师了！

huanglicheng

学习VS交流 发表于 2015-1-22 23:03
谢谢老师了！

1. Sub 删除前面空白段落()
   
2. 
   
3.     Dim i&, iCount&, arr, myText$, iEnd As Long
   
4.     arr = Split(ActiveDocument.Range.Text, Chr(13))
   
5. 
   
6.     Application.ScreenUpdating = False
   
7. With ActiveDocument.Paragraphs
   
8.         iCount = UBound(arr)
   
9.         '--------------------------------------------------
   
10.         For i = 0 To iCount - 1
    
11.             myText = Trim(arr(i))
    
12.             If Len(myText) = 0 Then
    
13.                 iEnd = .Item(i + 1).Range.End
    
14.             Else
    
15.                 .Item(i + 1).Range.Text = myText & vbLf
    
16.                 Exit For
    
17.             End If
    
18.         Next i
    
19.         '--------------------------------------------------
    
20.     End With
    
21.     If iEnd > 0 Then ActiveDocument.Range(0, iEnd).Delete
    
22.     Application.ScreenUpdating = True
    
23. End Sub
    

复制代码

学习VS交流

huanglicheng 发表于 2015-1-23 14:00

测试1一.rar (6.59 KB, 下载次数: 7)

2015-1-23 14:09 上传

点击文件名下载附件

谢谢老师的再次帮助
能实现效果
但有一个问题，执行代码后，如本附件，中第一个红色会改变颜色（也就是说，会改变文档的原始格式。）

请老师看看，不改变文档的原始格式，好吧

谢谢老师了！

huanglicheng

学习VS交流 发表于 2015-1-23 14:10
谢谢老师的再次帮助
能实现效果
但有一个问题，执行代码后，如本附件，中第一个红色会改变颜色（也 ...

最后一次帮你了 还有什么问题自己尝试去改下

1. Sub 删除前面空白段落()
   
2.     Dim i&, iCount&, arr, myText$, iEnd As Long
   
3.     Set regex1 = CreateObject("VBSCRIPT.REGEXP")    'RegEx为建立正则表达式
   
4.     With regex1
   
5.         .Global = True    '设置全局可用
   
6.         .Pattern = "[^ ]"
   
7.     End With
   
8.     '--------------------------------------------------
   
9.     arr = Split(ActiveDocument.Range.Text, Chr(13))
   
10.     Application.ScreenUpdating = False
    
11.     With ActiveDocument.Paragraphs
    
12.         iCount = UBound(arr)
    
13.         '--------------------------------------------------
    
14.         For i = 0 To iCount - 1
    
15.             myText = Trim(arr(i))
    
16.             If Len(myText) = 0 Then
    
17.                 iEnd = .Item(i + 1).Range.End
    
18.             Else
    
19.                 iEnd = iEnd + regex1.Execute(arr(i))(0).firstindex
    
20.                 Exit For
    
21.             End If
    
22.         Next i
    
23.         '--------------------------------------------------
    
24.     End With
    
25.     If iEnd > 0 Then ActiveDocument.Range(0, iEnd).Delete
    
26.     Application.ScreenUpdating = True
    
27. End Sub
    

复制代码

学习VS交流

huanglicheng 发表于 2015-1-23 14:26
最后一次帮你了 还有什么问题自己尝试去改下

感谢老师，非常好用！