批量提取下划线内容 代码

geryjun

我有一些试题的文档格式是这样的，
原文格式：
1.学会Excel不难，难的是怎么用好Excel！看似简单得不能再简单的一个小小技术，用得不恰当，很有可能给你带来无法估量的损失，这就是所谓的“细节决定成败”。
2.本书以一位职场新人—罗拉的成长经历为主线，告诉你Excel的数据录入、数据处理、工作表编辑、Excel与Word的邮件合并、Excel表格打印以及Excel的高级功能—批量填充输入、选择性粘贴、条件格式、数据有效性的设置、照相机功能的妙用、合并计算等。
3.本书不仅仅讲述Excel技巧，还有其他地方学不到的高调做事、低调做人的职场生存法则。所采用的情境教学法，能让你像看小说一样轻松学会Excel应用技巧，润物细无声地帮你培养应用Excel的良好习惯，树立正确的做事做人态度。
所有钟情于Excel的朋友们，赶快拿起书本享受学习的快乐吧！

实现效果：
1、下划线内容替换为________
2、下划线的内容复制到文件的最后部分。
3、每题的下划线不限为一个。

现已完美解决，代码请看 23 楼


详见如下：
1.学会Excel不难，难的是怎么用好Excel！________得不能再简单的一个小小技术，_______，很有可能给你带来无法_____的损失，这就是所谓的“细节决定成败”。
2.本书以一位职场新人—罗拉的成长经历为主线，告诉你Excel的数据录入、________、工作表编辑、Excel与Word的邮件合并、Excel表格打印以及Excel的高级功能—批量填充输入、选择性粘贴、条件格式、数据有效性的设置、照相机功能的妙用、合并计算等。
3.本书不仅仅讲述Excel技巧，还有其他地方学不到的高调做事、________的职场生存法则。所采用的情境教学法，能让你像看小说一样轻松学会Excel应用技巧，润物细无声地帮你培养应用Excel的良好习惯，树立正确的做事做人态度。
所有钟情于Excel的朋友们，赶快拿起书本享受学习的快乐吧！


1.看似简单  用得不恰当  估量
2.数据处理
3.低调做人

jia_yin

这个貌似蛮高级的吗~~~

安全为主

试试：
1.选中其中一个带下划线的，然后右击，点选最后的选择格式相似的文本，复制粘贴到最后仅文本格式。
2.查找替换，查找内容，高级 ，格式，字体下划线
替换内容    （打几个空格   ）   高级，格式字体下划线
全部替换。

geryjun

安全为主 发表于 2012-4-10 12:14
试试：
1.选中其中一个带下划线的，然后右击，点选最后的选择格式相似的文本，复制粘贴到最后仅文本格式。 ...

第一个可以实现，但第二个不是很完美。

安全为主

geryjun 发表于 2012-4-10 13:04
第一个可以实现，但第二个不是很完美。

这个可以参考下，其中可能有“完美”的答案。
Word常用查找与替换实例及方法(64例).rar (115.71 KB, 下载次数: 170)

2012-4-10 13:46 上传

点击文件名下载附件

geryjun

安全为主 发表于 2012-4-10 13:46
这个可以参考下，其中可能有“完美”的答案。

非常感谢。

413191246se

我抄微软帮助，也解决了第一个问题，第二个问题也解决不了！

Sub Find_Underline()
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Underline = wdUnderlineSingle
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineSingle
        End With
        .Execute FindText:="", ReplaceWith:=Space(9), Format:=True, Replace:=wdReplaceAll
    End With
End Sub

geryjun

413191246se 发表于 2012-4-10 16:43
我抄微软帮助，也解决了第一个问题，第二个问题也解决不了！

Sub Find_Underline()

谢谢，我也在想第二个问题的解决方法。第一个的方法较多。

geryjun

现在已经解决了第1个问题，第2个问题还没有待解决。

sqhsqhli

Sub Find_Underline()
Dim s As String, a As Integer
With ActiveDocument.Content.Find
'顺着找
.Font.Underline = wdUnderlineSingle
Do While .Execute(FindText:="", Format:=True)
a = a + 1
s = s & Chr(13) & a & "、" & .Parent
Loop
'倒回去替换
.Execute FindText:="", ReplaceWith:=Space(9), Format:=True, Replace:=wdReplaceAll, Forward:=False
End With
ActiveDocument.Range.InsertAfter s
End Sub