一道数据拆分难题，函数半天搞不定，VBA却一分钟解决问题！
送人玫瑰，手有余香，请将文章分享给更多朋友
动手操作是熟练掌握EXCEL的最快捷途径！
群里有一位群友提出了这样一个问题。感谢群友小白提供了这道题目的代码！
怎样将上面截图中左面单元格中的数据拆分成为右面的格式。
初步一看，好像可以使用SUBSTITUTE函数来拆分。但是仔细想想，虽然可以按标点符号来拆分，但对于价格部分没有特别好的办法拆出来。
如果说，就是一次性的工作，那直接就分列配合剪切板来解决问题；如果是重复性的工作，就需要编写一段VBA代码，或者利用POWER QUERY来解决了。
今天着重向大家介绍的是如何利用VBA和公式来解决这个问题。
使用公式并不能完全解决这个问题。
在单元格D5中输入公式“=TRIM(MID(SUBSTITUTE(SUBSTITUTE(TRIM(MID(SUBSTITUTE($A$1,CHAR(10),REPT(" ",99)),ROW(B1)*99-98,99)),"：","，"),"，",REPT(" ",99)),COLUMN(B1)*99-98,99))”，并向下向右拖曳即可。
思路：
这个公式看起来比较长，其实是非常简单大。由于公式没有最终完成，这里就不在详细解释公式了。简单说，就是连续两次使用了TRIM+MID+SUBSTITUTE函数组合。
通过VBA代码我们则可以完美地解决这个问题。
完成的代码如下：
Sub test()
Dim reg As Object
Dim arr(), alist
Dim i, j, m, k, n, ar
Set reg = CreateObject("vbscript.regexp")
Range("B1:ZZ65535").ClearContents
arr() = Range("A1:A" & Range("A65535").End(xlUp).Row + 1).Value
With reg
.Pattern = "(\d+月\d+日){0,}：?([\u4e00-\u9fa5]*)(\d+元)，?"
.Global = True
On Error Resume Next
For i = 1 To UBound(arr)
alist = Split(arr(i, 1), Chr(10))
For Each ar In alist
Set mnt = reg.Execute(ar)
If mnt.Count <> 0 Then
j = j + 1
n = 2
For k = 0 To mnt.Count - 1
For m = 0 To mnt(k).SubMatches.Count - 1
If m = 0 Then
If k = 0 Then Cells(j, n).Value = mnt(k).SubMatches(m)
Else
n = n + 1
Cells(j, n).Value = mnt(k).SubMatches(m)
End If
Next m
Next k
End If
Next
Next i
End With
End Sub
-END-
长按下方二维码关注EXCEL应用之家
面对EXCEL操作问题时不再迷茫无助
我就知道你“在看”