实现分列的两段excel vba 分列代码

excelvba分列多用于一般常规的分列操作完成不了的情况。

Excel内置的分列，仅用于有规律的数据进行分列。比如下面的截图，这样的数据源，分列就可以考虑使用excelvba分列完成。

A列数据源，要将汉字和数字分列后的效果如B:D列。

下面是两段excelvba分列的代码，案例和答案来自论坛版主。

第一段excelvba分列的代码：

Subvba分列()
   DimoJsAsObject,rngAsRange
   SetoJs=CreateObject("scriptControl"):oJs.Language="Jscript"
   oJs.eval"functiongets(str){returnstr.replace(/(\d+)/,'$1')}"
   ForEachrngInRange("A2",[A65536].End(3))
       rng(1,2).Resize(1,3)=Split(oJs.codeobject.gets(rng.Value),"")
   Next
EndSub

第二段excelvba分列的代码：

Subvba分列()
   Dimarr,i%,brr(),smaAsObject
   arr=Range("a2:a"&Cells(Rows.Count,1).End(3).Row)
   ReDimbrr(1ToUBound(arr),1To3)
   WithCreateObject("vbscript.regexp")
       .Global=True
       .Pattern="([^\d]+)(\d+)(.+)"
       Fori=1ToUBound(arr)
           Setsma=.Execute(arr(i,1))(0).submatches
           brr(i,1)=sma(0)
           brr(i,2)=sma(1)
           brr(i,3)=sma(2)
       Next
   EndWith
   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
   Setsma=Nothing
EndSub

代码使用方法，在excel中，按下ALT+F11，打开VBE编辑器，单击插入――模块，复制上面任意一段代码，按F5键运行即可完成分列。