|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub ss()
- Dim r&, i&, j&, d As Object, x, s$, a&, b&, n&
- Set d = CreateObject("scripting.dictionary")
- r = Cells(Rows.Count, 1).End(3).Row
- With CreateObject("VBScript.RegExp")
- .Pattern = "(.+?)(\d+)~.+?(\d+)$"
- For i = 1 To r
- x = Cells(i, 1)
- If .Test(x) Then
- s = .Replace(x, "$1")
- a = Val(.Replace(x, "$2"))
- b = Val(.Replace(x, "$3"))
- For j = a To b
- n = n + 1: d(n) = s & j
- Next
- End If
- Next
- End With
- Columns(2).ClearContents
- If d.Count Then [B1].Resize(d.Count, 1) = Application.Transpose(d.items)
- End Sub
复制代码 |
评分
-
2
查看全部评分
-
|