Excel VBA【函数：Split】按指定分隔符号分列字符串

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】【2023年8月】【2023年9月】【2023年10月】

实用案例

|日期控件||简单的收发存||收费管理系(Access改进版)|

|电子发票管理助手||电子发票登记系统(Access版)|

|文件合并||表格拆分||审计凭证抽查底稿|

|中医诊所收费系统(Excel版)||中医诊所收费系统(Access版)||银行对账单自动勾对|

收费使用项目

|财务管理系统||工资薪金和年终奖个税筹划|

内容提要

Split函数

大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：[求助] 以部位、号为断开，分开依次排列下去仅看这个标题，还真是一头雾水，下载附件看一下吧：他的源数据是这样的：

他的要求：

要求：以部位"、"号为断开，分开排列下去,单元格列可能要比G列要多，最好能以整张工作边的G列"、"号为断开排列，感谢。

我的理解是把G列内容，按照“、”号分列成多条记录。他的结果表是这样：

我的理解应该是没错，我们可以用Split函数对G列进行分列，得到一个字符串数组，再与前面的1~6列组合成新的记录。VBA代码：

Sub mySplit2() Dim ws As Worksheet Dim arr(), arrG() As String, arrTem() arr = Sheet1.UsedRange Set ws = Sheet2 m = 1 With ws .Cells(1, 1).CurrentRegion.Offset(1, 0).Clear For i = 2 To UBound(arr) arrG = Split(arr(i, 7), "、") For j = LBound(arrG) To UBound(arrG) ReDim Preserve arrTem(1 To 7, 1 To m) For k = 1 To 6 arrTem(k, m) = arr(i, k) Next arrTem(7, m) = arrG(j) If arrTem(1, m) = "" Then arrTem(1, m) = arrTem(1, m - 1) End If m = m + 1 Next Next .Cells(2, 1).Resize(UBound(arrTem, 2), _ UBound(arrTem)) = _ Application.WorksheetFunction. _ Transpose(arrTem) .Activate End WithEnd Sub代码解析：1、Line2~3，定义变量。2、Line4，把原始数据装入数组arr。3、Line8，目标工作表清除内容。4、Line9~22，循环数组arr，把第7列分列到数组arrG当中，接着循环arrG，重定义一个临时数组arrTem用于存放新记录，每条记录的1~6列都是当前arr的行记录，第7列是arrG的记录。由于原始数据表中的序号列，也就是第一列，有合并单元格，造成序号空值，这里也顺便处理一下。

5、Line23，把数组arrTem写入目标工作表。Split函数：1、基本语法：

Split(Expression, [Delimiter], [Limit], [Compare])2、Expression，要拆分的字符串。

3、Delimiter，指定的分隔符，默认为" "（空格），如果是一个0长度的字符，则返回整个字符串。

4、Limit，返回的数组元素的最大数目，默认返回所有子字符串。

5、Compare，指定比较的类型，可选值为0 = vbBinaryCompare - 执行二进制比较, 1 = vbTextCompare - 执行文本比较。

我们一般都是这样使用：Split(字符串,分隔符)，要注意的是，分列的结果是一个字符串数组，在定义变量的时候，要注意变量的类型，以下都是可以的：

Dim arrDim arr As VariantDim arr() As String后记

起初，我是直接把记录一条一条地写入目标工作表的：

Sub mySplit() Dim ws As Worksheet Dim arr(), arrG() As String arr = Sheet1.UsedRange Set ws = Sheet2 m = 2 With ws .Cells(1, 1).CurrentRegion.Offset(1, 0).Clear For i = 2 To UBound(arr) arrG = Split(arr(i, 7), "¡¢") For j = LBound(arrG) To UBound(arrG) For k = 1 To 6 .Cells(m, k) = arr(i, k) Next .Cells(m, 7) = arrG(j) If .Cells(m, 1) = "" Then .Cells(m, 1) = .Cells(m - 1, 1) End If m = m + 1 Next Next .Activate End WithEnd Sub但是在执行时，发现速度有点慢，才想起来应该用数组。

~~~~~~End~~~~~~

安利小店

安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！

合谷医疗

合谷医疗专攻各种疑难杂症，尤其擅长腰颈椎疾病、儿童神经发育异常、多动症、自闭孤独症治疗，可谓神乎其技！体验过的直呼早点来就好了！

喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！

案例文件分享说明：

案例文件可免费分享，但需符合以下要求：

请关注、点赞、点在看、点广告、留言，方便的话分享一下就完美啦！如果不便走上面的“流程”，请打赏，万分感谢！