先看看动态图：
将B列里用顿号给隔开的姓名，而且，每一列的姓名数量都不一样，多的少的都有。咱们现在的任务呢，就是得把这些姓名都给拆分开，让每个姓名都单独占一行，
那么如果反过来，将B列分散的姓名，以相同的厅合并到一个单元格中。
以前我都是用函数做，需要嵌套好几个函数，今天我只需用一秒不到就能拆分或合并这些姓名。
现在分享给大家。
第一步：制作自定义按钮
1、在Excel的菜单栏中，找到并点击“插入”选项卡。
2、在“插入”选项卡中，找到“形状”按钮
3、点击“形状”按钮，会弹出一个下拉菜单，其中包含各种可选择的形状，如圆角矩形
4、从下拉菜单中选择所需的形状。
5、按住鼠标左键不放，在工作表中拖动鼠标以绘制所选形状。
6、在“格式”选项卡中，可以设置形状的填充颜色、轮廓颜色、线条样式等。
7、还可以添加形状效果，如阴影、发光、三维旋转等。
第二步：编写VBA代码
1、右击其中一张工作表，选查看代码
2、在VBA编辑器中，点击“插入”菜单，然后选择“模块”以插入一个新的模块。
3、将以下代码复制并粘贴到模块中：
我把代码复制到这里，可以直接拷贝使用，
Sub 折分成行()
Dim brr(1 To 10, 1 To 2) ‘这里10是可以按需更改的。
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
crr = Split(arr(i, 2), "、")
For J = 0 To UBound(crr)
k = k 1
brr(k, 1) = arr(i, 1)
brr(k, 2) = crr(J)
Next
Next
[D2].Resize(UBound(brr), 2) = brr
End Sub
Sub 行拆成列()
Set dic = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
If Not dic.Exists(arr(i, 1)) Then
dic.Add arr(i, 1), arr(i, 2)
Else
dic(arr(i, 1)) = dic(arr(i, 1)) & "、" & arr(i, 2)
End If
Next
[D2].Resize(dic.Count, 1).Value = Application.WorksheetFunction.Transpose(dic.Keys)
[E2].Resize(dic.Count, 1).Value = Application.WorksheetFunction.Transpose(dic.items)
End Sub
第三步：连接按钮与代码
1、回到Excel工作表，右击你刚才绘制的形状（按钮）。
2、在弹出的菜单中，选择“指定宏”。
3、在弹出的“指定宏”对话框中，选择“折分成行”宏，然后点击“确定”。
同样把合并指定“行拆成列"，进行宏连接。
现在，当你点击该按钮时，Excel将执行“折分成行”宏，将B列中用顿号隔开的姓名拆分，并让每个姓名单独占一行。
评论 (0)