大神，怎样把0变成1的格式的简单方法？

joe4445

z9bhd

看看符合要求不
Sub lx()
    Dim wd As Document, p As Paragraph, t As Table, s As Cell, ar
        Set wd = ThisDocument
        a = wd.Paragraphs.Count
        For Each p In wd.Paragraphs
            If Len(p.Range.Text) <= 2 Then p.Range.Delete
        Next
        ar = Array("姓名", "所属支部", "年度积分", "1月", "2月", "3月")
        Selection.HomeKey unit:=wdStory
        Set t = wd.Tables.Add(Selection.Range, wd.Paragraphs.Count / 6 + 1, 6)
        For Each s In t.Range.Cells
            k = k + 1
            If k <= 6 Then
               s.Range.Text = ar(k - 1)
            Else
                s.Range.Text = Left(wd.Paragraphs(k + t.Range.Cells.Count).Range.Text, Len(wd.Paragraphs(k + t.Range.Cells.Count).Range.Text) - 1)
            End If
        Next
        For i = wd.Paragraphs.Count To wd.Tables(1).Range.Cells.Count + 7 Step -1
            wd.Paragraphs(i).Range.Delete
        Next
        wd.SaveAs2 (wd.Path & "\01-1.docx")
End Sub

z9bhd

Sub lx()
    Dim wd As Document, p As Paragraph, t As Table, s As Cell, ar, wd1 As Document
        Set wd = ThisDocument
        For Each p In wd.Paragraphs
            If Len(p.Range.Text) <= 2 Then p.Range.Delete
        Next
        Set wd1 = Documents.Add
        Set t = wd1.Tables.Add(Selection.Range, wd.Paragraphs.Count / 6 + 1, 6)
        ar = Array("姓名", "所属支部", "年度积分", "1月", "2月", "3月")
        For Each s In t.Range.Cells
            k = k + 1
            If k <= 6 Then
               s.Range.Text = ar(k - 1)
            Else
                s.Range.Text = Left(wd.Paragraphs(k - 6).Range.Text, Len(wd.Paragraphs(k - 6).Range.Text) - 1)
            End If
        Next
        wd1.SaveAs2 (wd.Path & "\1-1.docx")
        wd1.Close
        wd.Close 0
End Sub

wdpfox

学习中。。……。……。。…。……。谢谢分享！

Jason_WangSS

1. Sub 宏2()
   
2. '
   
3. ' 宏2 宏
   
4. '
   
5. '
   
6.     Selection.Find.ClearFormatting
   
7.     Selection.Find.Replacement.ClearFormatting
   
8.     With Selection.Find
   
9.         .Text = "-^p"
   
10.         .Replacement.Text = ""
    
11.         .Forward = True
    
12.         .Wrap = wdFindContinue
    
13.         .Format = False
    
14.         .MatchCase = False
    
15.         .MatchWholeWord = False
    
16.         .MatchByte = False
    
17.         .MatchWildcards = False
    
18.         .MatchSoundsLike = False
    
19.         .MatchAllWordForms = False
    
20.     End With
    
21.     Selection.Find.Execute Replace:=wdReplaceAll
    
22.     Selection.WholeStory
    
23.     n = Selection.Paragraphs.Count
    
24.     Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=6, _
    
25.          NumRows:=n / 6, AutoFitBehavior:=wdAutoFitFixed
    
26.     With Selection.Tables(1)
    
27.         .Style = "网格型"
    
28.         .ApplyStyleHeadingRows = True
    
29.         .ApplyStyleLastRow = False
    
30.         .ApplyStyleFirstColumn = True
    
31.         .ApplyStyleLastColumn = False
    
32.     End With
    
33. End Sub
    

复制代码

手动操作是选择全文，插入表格，文本转为表格，选择列数为15，生成即可