经常会遇到需要将一个单元格内的不同类别的数据提取出来，分列放置的要求，比如下面左侧的原数据，需要整理成右侧分解数据的样式。

excel自带的数据分列功能

一般我们会想到用excel自带的数据分列功能，但动手操作时就会发现，excel自带的数据分列有分隔符号分列和固定宽度分列两种模式，而案例中数据没有任何符号，各行的数据分列宽度也不统一，导致两种模式均无法用。

ctrl+E

再试试大名鼎鼎的ctrl+e快捷填充功能，还是解决不了，原因不细讲。

提取字符函数

想想就好，难度太大，超长公式一直是我们的抵制对象。

那难道我们只能手动去输入了吗？肯定不会了，来看看VBA的自定义函数fl()。

自定义函数公式：

B10单元格公式：=fl(A10,2,5,2,5,2,4)

公式解释：

函数名fl()，fl为“分列”的拼音首字母组合；

参数A10，为需要分解数据所在单元格；

参数2、5、2、5、2、4：为对要分解的数据从左向右依次取的位数，比如第一个2，即取A10单元格数据的最前面2位字符，即“樱桃”；第二个5，取紧接着的5位字符，即15元/斤，依次类推，得出所有数据。

通过上面的参数提取出对应的数据后，依次放到后面的单元格中，形成分列效果。

B11单元格公式：=fl(A11,2)

按照上面的逻辑，B11单元格公式应该是后面有6个2才对，为何公式只有一个2呢？

这是本函数的另一个功能特点，当后面的N个参数均相同时，只需一个参数即可，省略后面的其他重复参数。此时若直接将其他参数写上，也能得到相同的结果，但需要写全参数。即B11单元格公式，要么只写一个2，要么写6个2，不能写3个或4个。

再来看看fl函数按分割符分列数据的能力

看下面的左侧数据需整理成右侧数据

用excel自带数据分列功能时，又存在问题。

excel自带数据分列功能只设定了四种分割符号，且均未英文输入模式下的符号，另外设置了一个其他符号用于扩展，但一次也只能扩展一种符号。而案例中明显存在多个汉语输入模式下的符号：顿号、逗号、横杆、冒号。

这个时候我们一般先对符号进行替换，替换为四种自带的分割符号，但本案由于需替换的符合好几种，逐个提换也很麻烦。

来看看fl函数公式：

B3单元格公式：=fl(A3,".、：，—。 \")

公式解释：

看着写了很多，其实参数只有两个。

第一个参数：A3，为需要分解数据所在单元格；

第二个参数：".、：，—。 \"，为双引号括起来的需分解数据中作为分隔符的各种符号，符号个数无限制，本案中列了数据中出现的7种符号。一次性实现替换、分列功能

复制B3公式，分别粘贴至C3、D3单元格，完成。

存在的不足

上面案例中复制B3公式后，是分别粘贴至C3、D3格，若一次选择C3、D3单元格粘贴，公式也能进去，但只有最后面的单元格D3格公式能正常显示。即本函数存在的不足为：每次只能粘贴单个单元格，不能批量粘贴操作。

好在这个不足通过增加代码，是可以解决的，欢迎留言交流！

完整代码

模块代码：

Public myc, arr, brr, x, yFunction fl(rg As Range, Optional s1 As Variant, Optional s2 As Variant, _Optional s3 As Variant, Optional s4 As Variant, Optional s5 As Variant, Optional s6 As Variant)  On Error GoTo ren  str1 = rg.Value x = rg.Row y = rg.Column If IsMissing(s1) = False Then If IsNumeric(s1) = False Then For i = 1 To Len(s1) If Not IsError(Application.Find(Mid(s1, i, 1), str1)) Then _ str1 = Application.Substitute(str1, Mid(s1, i, 1), "//") Next Else If IsMissing(s2) Then lar = Len(str1) n = Int(lar / s1) For i = 1 To n str1 = Left(str1, s1 + (i - 1) * (s1 + 2)) & "//" & Mid(str1, s1 + (i - 1) * (s1 + 2) + 1, 99) Next Else str1 = Left(str1, s1) & "//" & Mid(str1, s1 + 1, 99) str1 = Left(str1, s1 + 2 + s2) & "//" & Mid(str1, s1 + 2 + s2 + 1, 99)  If IsMissing(s3) = False Then str1 = Left(str1, s1 + 4 + s2 + s3) & "//" & Mid(str1, s1 + 4 + s2 + s3 + 1, 99) If IsMissing(s4) = False Then str1 = Left(str1, s1 + 6 + s2 + s3 + s4) & "//" & Mid(str1, s1 + 6 + s2 + s3 + s4 + 1, 99) If IsMissing(s5) = False Then str1 = Left(str1, s1 + 8 + s2 + s3 + s4 + s5) & "//" & Mid(str1, s1 + 8 + s2 + s3 + s4 + s5 + 1, 99) If IsMissing(s6) = False Then str1 = Left(str1, s1 + 10 + s2 + s3 + s4 + s5 + s6) & "//" & Mid(str1, s1 + 10 + s2 + s3 + s4 + s5 + s6 + 1, 99) End If End If  brr = Split(str1, "//") fl = brr(0) End If Set myc = New css Set myc.sht = ActiveSheet Exit Function ren:  Set myc = New css Set myc.sht = ActiveSheet  End Function

类模块css代码

Public WithEvents sht As WorksheetPrivate Sub sht_change(ByVal target As Range) On Error GoTo ren Set myc.sht = Nothing Set myc = Nothing For i = 1 To UBound(brr) Cells(x, y + i + 1) = brr(i) Nextren:End Sub