|
本帖最后由 老司机带带我 于 2016-6-23 21:25 编辑
代码如下,结果生产在另外一个表中:- Sub XX()
- Dim str$, arr, brr(), crr, n&, j&, i&, k%, x&
- With Sheet1
- n = .Cells(.Rows.Count, 1).End(xlUp).Row
- arr = .Range("A2:O" & n)
- End With
- x = 1
- ReDim Preserve brr(1 To 15, 1 To x)
- For k = 1 To 15
- brr(k, x) = arr(1, k)
- Next
- For j = 2 To n - 1
- With CreateObject("ScriptControl")
- .Language = "JScript"
- str = .eval("'" & arr(j, 14) & "'.replace(/(\d+)/g,' $1 ');")
- crr = Split(Left(str, Len(str) - 1))
- For i = 0 To UBound(crr) Step 2
- x = x + 1
- ReDim Preserve brr(1 To 15, 1 To x)
- For k = 1 To 13
- brr(k, x) = arr(j, k)
- Next
- brr(14, x) = crr(i)
- brr(15, x) = crr(i + 1)
- Next
- End With
- Next
- Sheet3.Range("A1").Resize(UBound(brr, 2), 15) = Application.WorksheetFunction.Transpose(brr)
- End Sub
复制代码 |
|