批量删除单无格空行

天空飘过啥

ming0018 发表于 2018-5-21 17:27

解决大部分，但第二行的对齐方式被改变了，原来是左对齐的，用了代码后，变右对齐了，如下图画红线处：


麻烦抽时间帮我看看，谢谢了

天空飘过啥

413191246se 发表于 2018-5-21 17:37
m0018 朋友代码未做到位，请继续努力！

确实有特殊状况

天空飘过啥

duquancai 发表于 2018-5-21 18:42
有时间，我写个到位的代码。有时间再写哈。

期待您的方法
谢谢

413191246se

大功告成！！！

1. Sub 表格单元格空行删除()
   
2.     Dim t As Table, c As Cell, i As Paragraph
   
3.     For Each t In ActiveDocument.Tables
   
4.         For Each c In t.Range.Cells
   
5.             For Each i In c.Range.Paragraphs
   
6.                 If Asc(i.Range) = 13 And Len(i.Range) = 1 Then i.Range.Delete
   
7.             Next
   
8.             If Len(c.Range.Paragraphs.Last.Range) = 2 Then '最末段落字长为 2 则为空行-->删除上段末尾段落标记
   
9.                 If c.Range.Paragraphs.Count > 1 Then c.Range.Paragraphs(c.Range.Paragraphs.Count - 1).Range.Characters.Last.Delete
   
10.             End If
    
11.         Next
    
12.     Next
    
13. End Sub

复制代码

天空飘过啥

413191246se 发表于 2018-5-21 20:44
大功告成！！！

谢谢，可是问题和11楼一样

duquancai

413191246se 发表于 2018-5-21 20:44
大功告成！！！

真的大功告成了吗？请测试如下文档！仔细看看 第6个单元格和第7个单元格吧！
借此题目，提醒各位朋友，对Word对象理解深刻一下，不要浮于表面！

天空飘过啥

duquancai 发表于 2018-5-21 21:08
真的大功告成了吗？请测试如下文档！仔细看看 第6个单元格和第7个单元格吧！
借此题目，提醒各位朋友， ...

还是老师总结的意外状况比较全
希望老师能解决这些问题，谢谢

duquancai

天空飘过啥 发表于 2018-5-21 21:24
还是老师总结的意外状况比较全
希望老师能解决这些问题，谢谢

我记得前不久，我在论坛写代码：1.我写代码了，提问者还成大爷了！2.我写了代码了，提问者拿到代码一走了之，根本不回复了！3.我写代码了，还有人攻击我！鉴于此：不想在本论坛的本版块再写代码了！！！

天空飘过啥

duquancai 发表于 2018-5-21 22:24
我记得前不久，我在论坛写代码：1.我写代码了，提问者还成大爷了！2.我写了代码了，提问者拿到代码一走了 ...

谢谢老师继续关注我的帖子

您刚说令您寒心的3种情况，我可都没有哦

不在本论坛写代码了，别啊，看你的回复帖子记录超多，人很热情、技术更没的说，你不在本版块了，那可是我们这些菜鸟的一大损失啊！

413191246se

* 杜先生 提出了表格中套表格的更难状况，我无以应对，只能处理一些简单、规则的表格了；
* 杜先生 说的其它情况，是不是说我呢？我前一段也得罪了 杜先生……OMG！
* 希望 杜先生 不要走！继续为大家贡献力量。
* 楼主 说的左、右对齐问题，我认为问题不大，与这个删除表格单元格内空行比不算什么，故忽略。
* 最后也借鉴了一下 ming0018 朋友的代码，精简了一下，作为目前我个人的最终结果吧！

1. Sub 删除空行_表格单元格()
   
2. '光标在表格外，处理所有表格；否则，处理光标所在表格
   
3.     Dim t As Table, a As Long, c As Cell, i As Paragraph
   
4.     If Selection.Information(wdWithInTable) = True Then a = 1
   
5.     For Each t In ActiveDocument.Tables
   
6.         If a = 1 Then Set t = Selection.Tables(1)
   
7.         For Each c In t.Range.Cells
   
8.             For Each i In c.Range.Paragraphs
   
9.                 If Asc(i.Range) = 13 And Len(i.Range) = 1 Then i.Range.Delete
   
10.             Next
    
11.             With c.Range.Paragraphs
    
12.                 If .Count > 1 And Len(.Last.Range) = 2 Then
    
13.                     .Last.Previous.Range.Characters.Last.Delete
    
14.                 End If
    
15.             End With
    
16.         Next
    
17.         If a = 1 Then Exit For
    
18.     Next
    
19. End Sub

复制代码