word VBA删除中英混排的中文段落-有酬谢

土豆刺客

一直想写一个vba，批量清除包含中文的段落。
1.这些中文段落都有一一对应的英文，且在对应的英文段落下面
2.这些段落都放在表格里；
3.中文段落又包含有数字，标点符号；
具体如附件所示！

没有学过VBA，这段VBA不管用
Sub 删除此段()
Selection.HomeKey wdStory
With Selection.Find
.ClearFormatting
Do While .Execute(findtext:="[一-龥]")
.Parent.Bookmarks("\para").Range.Delete
Loop
End With
End Sub


能解决的话发个小微信红包感谢！

413191246se

1. Sub 删除中文段落()
   
2.     On Error Resume Next
   
3.     Dim i As Paragraph
   
4.     For Each i In ActiveDocument.Paragraphs
   
5.         If i.Range Like "*" & Chr(13) & Chr(7) Then
   
6.             i.Range.Font.Color = wdColorRed
   
7.             i.Range.Select
   
8.             Selection.MoveEnd unit:=wdCharacter, Count:=-1
   
9.             Selection.InsertParagraphAfter
   
10.         Else
    
11.             If i.Range Like "*[一-龥]*" Then i.Range.Delete
    
12.         End If
    
13.     Next
    
14.    
    
15. '再执行一遍
    
16.     For Each i In ActiveDocument.Paragraphs
    
17.         If i.Range Like "*" & Chr(13) & Chr(7) Then
    
18.             i.Range.Font.Color = wdColorRed
    
19.             i.Range.Select
    
20.             Selection.MoveEnd unit:=wdCharacter, Count:=-1
    
21.             Selection.InsertParagraphAfter
    
22.         Else
    
23.             If i.Range Like "*[一-龥]*" Then i.Range.Delete
    
24.         End If
    
25.     Next
    
26. 
    
27. 'Sub 表格空段删除()
    
28.     Dim t As Table, c As Cell, v As Long, p As Paragraph, x As Range
    
29.     For Each t In ActiveDocument.Tables
    
30.         For Each c In t.Range.Cells
    
31.             v = c.Range.Paragraphs.Count
    
32.             If v > 1 Then
    
33.                 '循环处理(不含最后一段)
    
34.                 Set x = ActiveDocument.Range(Start:=c.Range.Paragraphs(1).Range.Start, End:=c.Range.Paragraphs(v - 1).Range.End)
    
35.                 For Each p In x.Paragraphs
    
36.                     If Len(p.Range) = 1 Then p.Range.Delete
    
37.                 Next
    
38.                 '最后一段(字长=2则空白)
    
39.                 If Len(c.Range.Paragraphs(c.Range.Paragraphs.Count).Range) = 2 Then
    
40.                     c.Range.Paragraphs(c.Range.Paragraphs.Count - 1).Range.Characters.Last.Delete
    
41.                 End If
    
42.             End If
    
43.         Next
    
44.     Next
    
45. End Sub

复制代码

duquancai

都要过年，那得看你有多少酬谢！哈哈哈

土豆刺客

duquancai 发表于 2017-1-24 20:26
都要过年，那得看你有多少酬谢！哈哈哈

自己初步解决了，但是还不够完美！

土豆刺客

413191246se 发表于 2017-1-28 21:17

不够完美，但是给我提供了有用的东西！给你个小微信红包吧，不嫌弃的可以私信微信号！