|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
加一句清除代码- Sub qq()
- Dim regx, mh, mhk, arr, r%, i%
- r = [a65536].End(3).Row
- Columns("c").ClearContents
- arr = Range("a1:c" & r)
- Set regx = CreateObject("vbscript.regexp")
- regx.Pattern = "\b\d{7}\b"
- regx.Global = True
- For i = 2 To UBound(arr)
- Set mh = regx.Execute(arr(i, 2))
- If mh.Count > 0 Then
- For Each mhk In mh
- If mh.Count = 1 Then
- arr(i, 3) = arr(i, 3) & mhk
- Else
- arr(i, 3) = arr(i, 3) & mhk & " "
- End If
- Next
- End If
- Next
- Range("a1:c" & r) = arr
- End Sub
复制代码 否则越点越多 |
|