代码如何改进

batmanbbs

已经改成两段代码，不过需要一早通过审核后才能看到代码了

batmanbbs

审核好慢呦

batmanbbs

1. Sub 删除合计空表()
   
2. 
   
3.     Dim FindRng As Range
   
4.     Dim i%, rStart&, rEnd&, Text$
   
5. 
   
6.     With ActiveDocument
   
7.         i = 1
   
8.         Do Until i > .Tables.Count
   
9.             With .Tables(i)
   
10.                 rStart = .Cell(.Rows.Count, 1).Range.Start
    
11.                 rEnd = .Cell(.Rows.Count, .Columns.Count).Range.End
    
12.                 Text = ActiveDocument.Range(rStart, rEnd)
    
13.                 Text = Replace(Replace(Replace(Text, " ", ""), Chr(13), ""), Chr(7), "")
    
14.                 If Text = "合计" Then
    
15.                     Set FindRng = ActiveDocument.Range(0, .Range.Start)
    
16.                     With FindRng.Find
    
17.                         .ClearFormatting
    
18.                         .ParagraphFormat.OutlineLevel = wdOutlineLevel3
    
19.                         .Format = True
    
20.                         .Wrap = wdFindStop
    
21.                         .Forward = False
    
22.                         rStart = IIf(.Execute, FindRng.Start, 0)
    
23.                     End With
    
24.                     Set FindRng = ActiveDocument.Range(.Range.End, ActiveDocument.Content.End)
    
25.                     With FindRng.Find
    
26.                         .ClearFormatting
    
27.                         .ParagraphFormat.OutlineLevel = wdOutlineLevel3
    
28.                         .Format = True
    
29.                         .Wrap = wdFindStop
    
30.                         .Forward = True
    
31.                         rEnd = IIf(.Execute, FindRng.Start, ActiveDocument.Content.End)
    
32.                     End With
    
33.                     'Debug.Print ActiveDocument.Range(rStart, rEnd)
    
34.                     ActiveDocument.Range(rStart, rEnd).Delete
    
35.                 Else
    
36.                     i = i + 1
    
37.                 End If
    
38.             End With
    
39.         Loop
    
40.     End With
    
41. 
    
42.     Set FindRng = Nothing
    
43. End Sub

复制代码

1. Sub 删除表格空行()
   
2. '
   
3. '删除表格中除了第一列之外都是空白单元格的行
   
4. '
   
5.     Dim i%, iRow%, iCol%, rStart&, rEnd&, Text$
   
6. 
   
7.     If Selection.Tables.Count = 0 Then
   
8.         MsgBox "没有指定表格"
   
9.     Else
   
10.         With Selection.Tables(1)
    
11.             iRow = .Rows.Count
    
12.             iCol = .Columns.Count
    
13.             For i = iRow To 2 Step -1        '跳过表头第一行
    
14.                 rStart = .Cell(i, 2).Range.Start
    
15.                 rEnd = .Cell(i, iCol).Range.End
    
16.                 Text = ActiveDocument.Range(rStart, rEnd)
    
17.                 Text = Trim(Replace(Replace(Text, Chr(13), ""), Chr(7), ""))
    
18.                 If Len(Text) = 0 Then
    
19.                     .Cell(i, 2).Select
    
20.                     With Selection
    
21.                         .SelectRow: .Rows.Delete
    
22.                     End With
    
23.                 End If
    
24.             Next i
    
25.         End With
    
26.     End If
    
27. 
    
28. End Sub

复制代码

jstvic

batmanbbs 发表于 2023-6-2 07:55

真的非常感谢，这对我帮助很大，之后一定充分学习，谨慎提问