按条件截取一段文字中的数据

ggmmlol

1. Sub test()
   
2.     Dim r&, ar, br, d, rg, i&, j%, tmp
   
3.     r = Cells(Rows.Count, 1).End(xlUp).Row
   
4.     If r < 3 Then Exit Sub
   
5.     ar = Range("a1").Resize(r, 2)
   
6.     ReDim br(3 To r, 1 To 2)
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     Set rg = CreateObject("VBScript.RegExp")
   
9.     rg.Global = True
   
10.     rg.Pattern = ".*?([一-龥]+色)([一-龥]+岩)|.+?"
    
11.     For i = 3 To r
    
12.         For j = 2 To 1 Step -1
    
13.             d.RemoveAll
    
14.             tmp = Split(Trim(rg.Replace(ar(i, 1), "$" & j & " ")))
    
15.             For Each itm In tmp
    
16.                 d(itm) = ""
    
17.             Next
    
18.             br(i, j) = Join(d.keys, "、")
    
19.         Next
    
20.     Next
    
21.     [c3].Resize(r - 2, 2) = br
    
22. End Sub

复制代码

按指定条件读取一段话的文字.rar (16.86 KB, 下载次数: 6)

2018-7-11 00:13 上传

点击文件名下载附件