如何用代码提取划线单词到顶部和底部

zzpsx

如何用代码实现以下效果.rar (16.32 KB, 下载次数: 4)

2020-9-15 20:49 上传

点击文件名下载附件

413191246se

1. Sub test()
   
2.     Dim r As Range, s$
   
3.     With Selection
   
4.         If .Type = 1 Then MsgBox "Not-Select！", 0 + 16: End
   
5.         Set r = .Range
   
6.         With r.Find
   
7.             .ClearFormatting
   
8.             .Text = ""
   
9.             .Font.Underline = wdUnderlineSingle
   
10.             .Forward = True
    
11.             .MatchWildcards = True
    
12.             Do While .Execute
    
13.                 With .Parent
    
14.                     s = s & "/" & .Text
    
15.                 End With
    
16.             Loop
    
17.         End With
    
18.         .InsertBefore Text:=s & vbCr
    
19.         .Paragraphs(1).Range.ListFormat.ConvertNumbersToText
    
20.         .Characters(1).Delete
    
21.         Do While .Next Like "[!a-zA-Z]"
    
22.             .Delete
    
23.         Loop
    
24.         If .Paragraphs(1).Range Like "/*" Then .Paragraphs(1).Range.Characters(1).Delete
    
25.     End With
    
26. End Sub

复制代码

zzpsx

这个更难了

413191246se

1. Sub test提取下划线单词到选区前后()
   
2.     Dim r As Range, s As Range, i$, j$, n&
   
3.     With Selection
   
4.         If .Type = 1 Then MsgBox "Not-Select！", 0 + 16: End
   
5.         Set r = .Range
   
6.         Set s = .Range
   
7.         With r.Find
   
8.             .ClearFormatting
   
9.             .Text = ""
   
10.             .Font.Underline = wdUnderlineSingle
    
11.             .Forward = True
    
12.             .MatchWildcards = True
    
13.             Do While .Execute
    
14.                 With .Parent
    
15.                     n = n + 1
    
16.                     i = i & "  " & .Text
    
17.                     j = j & n & "." & .Text & "  "
    
18.                     .Text = Space(7)
    
19.                     .SetRange Start:=.End, End:=s.End
    
20.                 End With
    
21.             Loop
    
22.         End With
    
23.         .InsertBefore Text:=i & vbCr
    
24.         .Paragraphs(1).Range.ListFormat.ConvertNumbersToText
    
25.         .Characters(1).Delete
    
26.         Do While .Next Like "[!a-zA-Z]"
    
27.             .Delete
    
28.         Loop
    
29.         .Delete
    
30.         s.InsertAfter Text:="参考答案：" & j & vbCr
    
31.     End With
    
32. End Sub

复制代码

zzpsx

如何随机排列单词.rar (10.61 KB, 下载次数: 2)

2020-9-18 08:06 上传

点击文件名下载附件

cuanju

zzpsx 发表于 2020-9-18 08:06

Sub ddddddd()
    Rem word选定区域所有单词打乱顺序
    Rem 如果重复多次运行，则可以按照不同顺序打乱
    Dim a, c As New Collection
    ss = Selection
    a = Split(ss, " ") '按照空格将单词拆分
    For i = 0 To UBound(a)
      If a(i) Like "*[A-Za-z]*" Then c.Add a(i)
    Next
    For i = 1 To c.Count
        n = Int(c.Count * Rnd + 1)
        s = s & c(n) & "  "
        c.Remove (n)
    Next
    If Selection.Characters.Last = Chr(13) Then
        Set oRng = Selection
        oRng.End = oRng.End - 1
        oRng.Select
    End If
    Selection = Replace(s, Chr(13), "")
End Sub

413191246se

cuanju 老师厉害！我一见乱序就害怕。