实现分列的两段excelvba分列代码

发布网友 发布时间：2024-09-26 17:51

我来回答

共1个回答

热心网友 时间：2024-10-04 17:05

excel vba 分列多用于一般常规的分列操作完成不了的情况。
　　Excel内置的分列，仅用于有规律的数据进行分列。比如下面的截图，这样的数据源，分列就可以考虑使用excel vba 分列完成。
　　A列数据源，要将汉字和数字分列后的效果如B:D列。
　　下面是两段excel vba 分列的代码，案例和答案来自论坛版主。
　　第一段excel vba 分列的代码：
Sub vba分列()
Dim oJs As Object, rng As Range
Set oJs = CreateObject("ScriptControl"): oJs.Language = "JScript"
oJs.eval "function gets(str){return str.replace(/(\d+)/,’ $1 ‘)}"
For Each rng In Range("A2", [A65536].End(3))
rng(1, 2).Resize(1, 3) = Split(oJs.codeobject.gets(rng.Value), " ")
Next
End Sub

　　第二段excel vba 分列的代码：
Sub vba分列()
Dim arr, i%, brr(), sma As Object
arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 3)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "([^\d]+)(\d+)(.+)"
For i = 1 To UBound(arr)
Set sma = .Execute(arr(i, 1))(0).submatches
brr(i, 1) = sma(0)
brr(i, 2) = sma(1)
brr(i, 3) = sma(2)
Next
End With
Range("b2", Cells(Rows.Count, Columns.Count)).ClearComments
Range("b2").Resize(UBound(brr), UBound(brr, 2)).NumberFormat = "@"
Range("b2").Resize(UBound(brr), UBound(brr, 2)) = brr
Set sma = Nothing
End Sub
　　代码使用方法，在excel中，按下ALT+F11，打开VBE编辑器，单击插入——模块，复制上面任意一段代码，按F5键运行即可完成分列。

热心网友 时间：2024-10-04 17:06

excel vba 分列多用于一般常规的分列操作完成不了的情况。
　　Excel内置的分列，仅用于有规律的数据进行分列。比如下面的截图，这样的数据源，分列就可以考虑使用excel vba 分列完成。
　　A列数据源，要将汉字和数字分列后的效果如B:D列。
　　下面是两段excel vba 分列的代码，案例和答案来自论坛版主。
　　第一段excel vba 分列的代码：
Sub vba分列()
Dim oJs As Object, rng As Range
Set oJs = CreateObject("ScriptControl"): oJs.Language = "JScript"
oJs.eval "function gets(str){return str.replace(/(\d+)/,’ $1 ‘)}"
For Each rng In Range("A2", [A65536].End(3))
rng(1, 2).Resize(1, 3) = Split(oJs.codeobject.gets(rng.Value), " ")
Next
End Sub

　　第二段excel vba 分列的代码：
Sub vba分列()
Dim arr, i%, brr(), sma As Object
arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 3)
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "([^\d]+)(\d+)(.+)"
For i = 1 To UBound(arr)
Set sma = .Execute(arr(i, 1))(0).submatches
brr(i, 1) = sma(0)
brr(i, 2) = sma(1)
brr(i, 3) = sma(2)
Next
End With
Range("b2", Cells(Rows.Count, Columns.Count)).ClearComments
Range("b2").Resize(UBound(brr), UBound(brr, 2)).NumberFormat = "@"
Range("b2").Resize(UBound(brr), UBound(brr, 2)) = brr
Set sma = Nothing
End Sub
　　代码使用方法，在excel中，按下ALT+F11，打开VBE编辑器，单击插入——模块，复制上面任意一段代码，按F5键运行即可完成分列。