提取填空题答案无果

weiyingde

sylun 发表于 2020-3-28 10:28
也可以试试如下提取方法。楼主原代码无果的主要原因是查找范围（一个段落）与查找代码（跨段落）不匹配。至 ...

谢谢大侠赐代码。
知道大侠身手不凡，果然不错。
加你为友，向你学习。愿不吝赐教。
谢谢你。

weiyingde

sylun 发表于 2020-3-28 10:28
也可以试试如下提取方法。楼主原代码无果的主要原因是查找范围（一个段落）与查找代码（跨段落）不匹配。至 ...

Val(.Paragraphs(1).Range.Text)
这个太妙了，试了一下。非常非常好用。
比用left要省心，
比用正则要简洁。
大侠真是身手不凡……

weiyingde

sylun 发表于 2020-3-28 10:28
也可以试试如下提取方法。楼主原代码无果的主要原因是查找范围（一个段落）与查找代码（跨段落）不匹配。至 ...

大侠，能否结合我的代码说一说，说一下。
若能在我的代码基础之上进行修改，那太好了。

weiyingde

sylun 发表于 2020-3-28 10:28
也可以试试如下提取方法。楼主原代码无果的主要原因是查找范围（一个段落）与查找代码（跨段落）不匹配。至 ...

For i = 1 To .Paragraphs.Count
        Set rng = .Paragraphs(i).Range
这已经是遍历文档段落了，
With rng.Find
                If .Execute("^13[0-9]@\.", , , 1) Then
这应该是按段落查找了
………………
真是弄不明白，盼望大侠给解惑！

weiyingde

QQ214189912 发表于 2020-3-27 21:09
.............

你的代码我整理出来了，测试没有效果，你看看是不是？
Sub test2()
Dim rng As Range, myrange As Range, inti As Integer
Dim istr01 As String, istr02 As String, istr03 As String
Dim dic As Object, myRegExp As Object, mhs As Object
Dim ky As Variant, tm As Variant
Set dic = CreateObject("scripting.dictionary")
Set myRegExp = CreateObject("Vbscript.RegExp")
With ActiveDocument
     For inti = 1 To .Paragraphs.Count
         Set rng = .Paragraphs(inti).Range
         With rng
              myRegExp.MultiLine = True
              myRegExp.Pattern = "(^\d{1,}\.).*"
              If myRegExp.test(.Text) Then
                 Set mhs = myRegExp.Execute(.Text)
                 If mhs.Count = 0 Then Exit Sub
                 istr01 = mhs(0).submatches(0)
                 With .Find
                      .ClearFormatting
                      .Font.Underline = wdUnderlineWavy
                      Do While .Execute
                         If .Parent.InRange(myrange) Then Exit Do
                            istr02 = .Parent.Text
                            If dic.Exists(istr01) Then
                               dic(istr01) = dic(istr01) & Space(2) & istr02
                            Else
                               dic(istr01) = istr02
                            End If
                       Loop
                  End With
                End If
            End With
        Next
    End With
    ky = dic.keys
    tm = dic.items
    For inti = LBound(ky) To UBound(ky)
        istr03 = istr03 & ky(inti) & tm(inti) & Chr(13)
    Next
    Documents.Add.Content.Text = istr03
End Sub

sylun

weiyingde 发表于 2020-3-28 17:35
For i = 1 To .Paragraphs.Count
        Set rng = .Paragraphs(i).Range
这已经是遍历文档段落了，

在一个学习与交流的平台，各人的学习目的，时间长短、决心与力度等不尽相同。我想只要用心就会有收获。我以前在这个平台混了很长一段时间，后来因工作关系就较少参与了。总的说来获益不少，但这毕竟是一点个人业余爱好，并非专业人士，即使理解也不一定到位。
就这几行代码，我觉得，
(1)如要遍历段落，也许遍历集合对象好些，即for each ...
(2)对于查找代码"^13[0-9]@\."中，如果有匹配，第一个字符（段落标记）与其他字符不属于同一个段落的范围，常规情况下，在一个正常段落中不可能有这样的匹配，因此无果是正常的。另外，反斜杠在这时里是多余的，因为其后的点号不是可用作通配符的字符
至于其他因素，楼主可以查看一下find对象的相关说明

weiyingde

sylun 发表于 2020-3-28 18:50
在一个学习与交流的平台，各人的学习目的，时间长短、决心与力度等不尽相同。我想只要用心就会有收获。我 ...

从代码的简洁性和逻辑联系看，知道大侠功力不凡，以后有请教，还望不吝赐教。
事实上，这也是我的业余爱好，但就是割舍不开。
也许是与VBA的怪异情缘吧。

weiyingde

duquancai 发表于 2020-3-27 22:40
请问：是不是如下代码的意思？

Sub 提取划线内容2()

答案都取出来，但就是有一点。题号有许多是重复的。
本来我想自己揣摩体会，自己修改一下，谁知脑力有限，一时还不能如愿。
你若有功夫再看一下，如何？
要求如下：
1.身体外形的变化  内部器官的变化  性机能的成熟  2.充沛的精力  敏捷的思维  强烈渴望 3.遗传  营养  锻炼  4.外在美  内在美
就像红色的数字，是不同的。

weiyingde

413191246se 发表于 2020-3-26 23:26
* 魏老师：我的代码不如您的高级，对付着用吧，未做优化，仅供参考：

分子已经都给完了，遗憾了，只有下次了。再次表示谢意。

duquancai

weiyingde 发表于 2020-3-28 19:15
答案都取出来，但就是有一点。题号有许多是重复的。
本来我想自己揣摩体会，自己修改一下，谁知脑力有限 ...

题号是重复的？你把附件传上来，最终要达到什么目的？