如何把一、（一） 1. （1）开头的段落提取到EXCEL中

jiminyanyan · 发表于 2016-10-8 21:08

请教：如何把一、（一） 1. （1）开头的段落提取到EXCEL中。

duquancai · 发表于 2016-10-8 21:13

请参考：http://club.excelhome.net/thread-1296542-1-3.html

duquancai · 发表于 2016-10-8 21:23

duquancai 发表于 2016-10-8 21:13
请参考：http://club.excelhome.net/thread-1296542-1-3.html

对不起，提供错了，请参考这个链接http://club.excelhome.net/forum.php?mod=viewthread&tid=1300625（1）、（2）、（3）、……。          .Pattern = "^（\s*\d+\s*）[^\r]*$"
（一）、（二）、（三）、……。       .Pattern = "^（\s*[一二三四五六七八九十〇百千万]+\s*）[^\r]*$"
（A）、（B）、（C）、……。          .Pattern = "^（[A-Z]+）[^\r]*$"
（a）、（b）、（c）、……。          .Pattern = "^（[a-z]+）[^\r]*$"
⒈⒉⒊……。                                  .Pattern = "^[\u2488-\u249B][^\r]*$"
①、②、③……。                            .Pattern = "^[\u2460-\u2473][^\r]*$"
㈠、㈡、㈢……。                            .Pattern = "^[\u3220-\u3229][^\r]*$"

jiminyanyan · 发表于 2016-10-8 21:51

duquancai 发表于 2016-10-8 21:23
对不起，提供错了，请参考这个链接http://club.excelhome.net/forum.php?mod=viewthread&tid=1300625（1 ...

老师帮忙看一下，为什么这个代码实现不了我的需求，好像或的效果没实现

Sub shishi()
Dim mt, oRang As Range, rng As Range, n%, m%
Dim arr(1 To 10000, 1 To 1)
Set rng = ActiveDocument.Content
Dim s1, s2, s3, s4
s1 = "^[一二三四五六七八九十〇百千万]+、\s*）[^\r]*$"
s2 = "^（\s*[一二三四五六七八九十〇百千万]+\s*）[^\r]*$"
s3 = "^[\u2488-\u249B][^\r]*$"
s4 = "^（\s*\d+\s*）[^\r]*$"
s = s1 & "|" & s2 & "|" & s3 & "|" & s4
With CreateObject("vbscript.regexp")
.Pattern = s1 & "|" & s2 & "|" & s3 & "|" & s4
.Global = True: .MultiLine = True
For Each mt In .Execute(rng)
m = mt.FirstIndex: n = mt.Length
Set oRang = ActiveDocument.Range(m, m + n)
'oRang.Font.Size = 14
'oRang.Font.Name = "宋体"
k = k + 1
arr(k, 1) = oRang.Text
Next
End With
With CreateObject("Excel.Application")
If Tasks.Exists("Microsoft Excel") = True Then Tasks("Microsoft Excel").Close
Set myBook = .Workbooks.Add: .Visible = True
Set mysheet = myBook.Worksheets("sheet1"): mysheet.Activate
mysheet.Range("a1").Resize(10000, 1) = arr
End With
Set myBook = Nothing
Set mysheet = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

kszcs · 发表于 2016-10-8 21:55

期待同样的答案

duquancai · 发表于 2016-10-8 22:19

本帖最后由 duquancai 于 2016-10-8 22:20 编辑

jiminyanyan 发表于 2016-10-8 21:51
老师帮忙看一下，为什么这个代码实现不了我的需求，好像或的效果没实现

没有测试，我猜：多半是出自元字符 | 或的问题上。这个元字符有点讲究先后顺序。你查一查资料吧：
s1 = "(^[一二三四五六七八九十〇百千万]+、\s*[^\r]*$)"
s2 = "(^（\s*[一二三四五六七八九十〇百千万]+\s*）[^\r]*$)"
s3 = "(^[\u2488-\u249B][^\r]*$)"
s4 = "(^（\s*\d+\s*）[^\r]*$)"
都加上英文状态的小括号，你再测试一下吧！！！

duquancai · 发表于 2016-10-8 22:23

jiminyanyan 发表于 2016-10-8 21:51
老师帮忙看一下，为什么这个代码实现不了我的需求，好像或的效果没实现

注意小括号》》》》》》》》》》》》

jiminyanyan · 发表于 2016-10-8 22:45

duquancai 发表于 2016-10-8 22:23
注意小括号》》》》》》》》》》》》

谢谢老师，s3那个没试成功，我自己换了个，好像可以了。

Sub shishi()
Dim mt, oRang As Range, rng As Range, n%, m%
Dim arr(1 To 10000, 1 To 1)
Set rng = ActiveDocument.Content
Dim s1, s2, s3, s4
s1 = "(^[一二三四五六七八九十〇百千万]+、\s*[^\r]*$)"
s2 = "(^（\s*[一二三四五六七八九十〇百千万]+\s*）[^\r]*$)"
s3 = "(^[\d]+\.[^\r]*$)"
's3 = "(^[\u2488-\u249B][^\r]*$)"
s4 = "(^[（(]\s*\d+\s*[)）][^\r]*$)"
s = s1 & "|" & s2 & "|" & s3 & "|" & s4
With CreateObject("vbscript.regexp")
.Pattern = s
.Global = True: .MultiLine = True
For Each mt In .Execute(rng)
m = mt.FirstIndex: n = mt.Length
Set oRang = ActiveDocument.Range(m, m + n)
'oRang.Font.Size = 14
'oRang.Font.Name = "宋体"
k = k + 1
arr(k, 1) = oRang.Text
Next
End With
With CreateObject("Excel.Application")
If Tasks.Exists("Microsoft Excel") = True Then Tasks("Microsoft Excel").Close
Set myBook = .Workbooks.Add: .Visible = True
Set mysheet = myBook.Worksheets("sheet1"): mysheet.Activate
mysheet.Range("a1").Resize(10000, 1) = arr
End With
Set myBook = Nothing
Set mysheet = Nothing
Application.ScreenUpdating = True
End Sub

复制代码

jiminyanyan · 发表于 2016-10-8 22:49

kszcs 发表于 2016-10-8 21:55
期待同样的答案

我8楼的代码应可以了。

wdpfox · 发表于 2017-6-13 10:35

学习收藏了，多谢老师慷慨分享好资料！
　　　　　　Oooo
　　　　　　(___)
　　oooO 　 )_/
　　(___) 　 (_/
　　 \_(
　　　\_)

		自动登录	找回密码
密码			免费注册

[求助] 如何把一、（一） 1. （1）开头的段落提取到EXCEL中

评分

评分

评分

[求助] 如何把一、（一） 1. （1） 开头的段落提取到EXCEL中

评分

评分

评分

[求助] 如何把一、（一） 1. （1）开头的段落提取到EXCEL中