[已解决]以数字和符号拆分重排.zip

水木

以数字和符号拆分重排.zip (17.66 KB, 下载次数: 10)

2014-10-6 17:50 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-7 06:30

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 60000, 1 To 4), i&, s%, n&, zf$
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. With CreateObject("vbscript.regexp")
   
5.     .Pattern = "\d、.+?\/"
   
6.     .Global = True
   
7.     For i = 2 To UBound(arr)
   
8.         s = 0
   
9.         For Each m In .Execute(arr(i, 3))
   
10.             n = n + 1: s = s + 1
    
11.             brr(n, 1) = arr(i, 1)
    
12.             brr(n, 2) = arr(i, 2)
    
13.             brr(n, 3) = s
    
14.             zf = Split(m, "、")(1)
    
15.             brr(n, 4) = Left$(zf, Len(zf) - 1)
    
16.         Next
    
17.     Next
    
18. End With
    
19. Sheet2.Activate
    
20. ActiveSheet.UsedRange.ClearContents
    
21. [a1:d1] = Array("作者", "类目", "序号", "内容")
    
22. Range("a2").Resize(n, 4) = brr
    
23. End Sub

复制代码

dsmch

………………