用ExcelVBA实现自动拆分单元格中的内容到多行中

一、背景

  我们在使用Excel办公软件的时候，有时会遇到这种情况：我们想把一个或多个单元格中的内容拆分到多行。例如表1所示：

药品名称	简述	详述
健胃消食片	1、成分； 2、性状； 3、功能主治； 4、规格； 5、用法用量；	1、太子参、陈皮、山药、炒麦芽、山楂。辅料为蔗糖、硬脂酸镁。 2、本品为浅棕黄色的片。气微香，味微甜、酸。 3、健胃消食。用于脾胃虚弱所致的食积，症见不思饮、嗳腐酸臭、腕腹胀满；消化不良见上述证候者。 4、每片重0.5克。 5、口服，可以咀嚼。一次4-6片，一日3次。小儿酌减。 6、怎么多了一项？

  我们有时想把表1的第2列、第3列，拆成表2的形式：

药品名称	简述	详述
健胃消食片	1、成分；	1、太子参、陈皮、山药、炒麦芽、山楂。辅料为蔗糖、硬脂酸镁。
健胃消食片	2、性状；	2、本品为浅棕黄色的片。气微香，味微甜、酸。
健胃消食片	3、功能主治；	3、健胃消食。用于脾胃虚弱所致的食积，症见不思饮、嗳腐酸臭、腕腹胀满；消化不良见上述证候者。
健胃消食片	4、规格；	4、每片重0.5克。
健胃消食片	5、用法用量；	5、口服，可以咀嚼。一次4-6片，一日3次。小儿酌减。
健胃消食片		6、怎么多了一项？

二、我们怎样拆它？

• 手动拆  我们可以在Excel里手动拆，当然，批量操作时，很耗时间的 ╥﹏╥...
• 自动拆  可以考虑编写ExcelVBA程序来实现，这能提高不少效率呢~

  我呢，当然是选择自动拆啦 ( ╯▽╰)

三、我心目中的自动拆

  怎样才算是合格的自动拆呢？只要我们编写出来的程序能实现下面三个功能就OK啦：

1. 可拆一，也可拆多：既可以拆分一个单元格中的内容，也可以拆分一行多列单元格区域中的内容；
2. 一行多列，不完全对应时，也能拆：比如表1中，虽然“详述”列多了第6项，但仍可以拆成表2的形式；
3. 未拆的部分，自动复制：比如表2中，“健胃消食片”就是自动复制的。

四、代码时刻

  代码分了三部分：
    第1步，把拆分的数据存放到数组里；
    第2步，在所选区域上方，插入行，并且复制所选区域的内容；
    第3步，将数组中的数据覆盖拆分区域。
  接下来就是激动人心的代码时刻了(≧∇≦)ﾉ

Sub ChaiFenDanYuanGe()
'声明变量
Dim arr() As String '定义一个字符串数组，用来存放单元格拆分后的数据
Dim m%              '定义一个整数，用来记录单元格内容需拆分的总行数
Dim n%              '定义一个整数，用来记录要拆分单元格的总个数
Dim row1, col1      '记录所选单元格所在的行数 和 列数
Dim i%, j%          '循环计数变量
Dim max%            '记录最大整数

'第1步，把拆分的数据存放到数组arr里
    '第1.1步，确定要拆多少行，即确定m的值
        '第1.1.1步，选择区域有几列？也就是要拆分的单元格的总个数，即n的值
        '注意：我们选择的区域都是1行1列 或 1行多列
        n = Selection.Count
    If n = 1 Then   '如果选择区域仅有一个单元格，那么...
        m = UBound(VBA.Split(Selection.Cells(1, n), Chr(10)))
    Else            '如果选择区域不止一个单元格，那么通过比较，确定出选中区域，单元格能拆分的最多行数
        m = UBound(VBA.Split(Selection.Cells(1, 1), Chr(10)))
        For i = 2 To n
            max = UBound(VBA.Split(Selection.Cells(1, i), Chr(10)))
            If max > m Then
                m = max
            End If
        Next i
    End If
    
    '第1.2步，存数据到数组，
    'split分隔符是chr(10)，也就是单元格里的alt+enter这种回车
    '如果要用其他的分隔符，如用分号分隔，则直接split(单元格，"；")即可
    ReDim arr((n - 1), m) '数组arr()是m+1行，n列
    For i = 0 To (n - 1)
        '获取单元格split后的字符串个数，防止下标j越界
        max = UBound(Application.Transpose(Application.Transpose(VBA.Split(Selection.Cells(1, i + 1), Chr(10))))) - 1
        For j = 0 To m
            If j <= max Then
                arr(i, j) = Application.Transpose(Application.Transpose(VBA.Split(Selection.Cells(1, i + 1), Chr(10))))(j + 1)
            End If
        Next j
    Next i

'第2步，在所选区域上方，插入m行，并且复制所选区域的内容
    '第2.1步，获取activecell所在的行数，selection第一个单元格的列数
    row1 = ActiveCell.Row
    col1 = Selection.Cells(1, 1).Column
    '第2.2步，插入m行
    For i = 1 To m
        Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Next i
    '第2.3步，复制行
    Cells(row1 + m, 1).EntireRow.Copy
    Range(Cells(row1, 1), Cells(row1 + m - 1, 1)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

'第3步，将数组arr中的数据覆盖拆分区域
For i = 0 To n - 1
    For j = 0 To m
        Cells(row1 + j, col1 + i) = arr(i, j)
    Next j
Next i
'大功告成，将焦点放在A1单元格
Cells(1, 1).Select
End Sub

五、温馨提示

• 插入按钮：可以在Excel工作表中插入按钮控件，关联此程序，即可实现点击按钮就自动拆分的效果，如下图所示：
  自动拆分效果图
• 学习ExcelVBA：推荐到我要自学网（www.51zxw.net）上学习哦~

最后，感谢大家阅读此文，感谢大家给予肯定和提出改进建议，谢谢O(∩_∩)O~