编按：

哈喽，大家好，在之前的教程中给大家分享过如何用PQ来将二维表转为一维表，今天来教大家一个一劳永逸的办法——VBA，赶紧来看一看吧！

如果将一维数据转化成二维数据，最好最直接的方法就是使用数据透视表。那么今天的问题是，如果将二维数据转化成一维数据呢？作者E图表述就遇到了一位网友的求助，他的数据表如下图所示：

他的需求是将这样的一组数据，转化成下面的格式：

因为源数据中存在合并单元格，如果我们使用函数的做法来做，会相当的困难（即便没有合并单元格，使用函数操作二维表转一维表同样没那么容易）。这里作者E图表述就给大家介绍个方法，希望在工作中能够给大家带来一些启迪。

打开工作表后，按ALT+F11组合键，打开VBE界面，在工程窗口单击鼠标右键，按下图插入一个模块。

选中模块，在属性窗口（如果你没有属性窗口，可以按F4弹出），在名称处直接改成你要的字即可。

双击刚才添加的模块，使得代码区是模块的代码输入区域。将下面的代码复制到你的代码区：

Sub 二转一()

  With Sheets("转化前") '''使用工作表《转化前》

    arr = .UsedRange '''利用UsedRange属性，将使用的单元格区域放入数组arr中，形成二维数组

  End With '''with结束语句

'''在数组中将合并单元格造成的空值填充上值

  For i = 2 To UBound(arr) '''循环变量i，在第2行开始，循环到最后一行数据，循环第一维度

    If arr(i, 1) = "" Then '''判断语句，如果数组第一列的值为空，则

      arr(i, 1) = arr(i - 1, 1) '''此数组元素值等于上一行的数组元素值

    End If '''判断语句结束

  Next i '''循环语句结束

  Set d = CreateObject("scripting.dictionary") '''定义d为字典脚本

  For i = 2 To UBound(arr) '''再次逐行遍历数组arr

    For j = 3 To UBound(arr, 2) - 1 '''循环变量j，从第3列开始，逐列循环数组arr的第二维度，不包含最后一列

      If arr(i, j) > 0 Then '''如果行列交叉点上的数组元素值大于0，则说明此值我们应该罗列

        s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(1, j) '''将型号、颜色、规格，合并为一个字符串s，用|间隔

        d(s) = arr(i, j) '''将s字符串装入字典d的key中，并且赋值对应item值为对应的数值

      End If '''判断语句结束

    Next j '''j循环语句结束

  Next i '''i循环语句结束

  With Sheets("转化后") '''使用工作表《转化后》

    .UsedRange.ClearContents '''使用ClearContents方法，将被使用单元格区域清空

    .[A1] = "型号" '''A1单元格赋值字符串“型号”

    .[B1] = "颜色" '''同上，赋值B1单元格

    .[C1] = "规格" '''同上，赋值C1单元格

    .[D1] = "数值" '''同上，赋值D1单元格

    k = 1 '''设置一个变量k，初始值为1

    For Each dic In d.keys '''在字典d中循环每一个字典元素dic

      k = k + 1 '''计数器，每循环一次，累加1。作为单元格行号使用

'''Split函数：按指定字符，拆分字符串，成为一个一维数组，数组编号从0开始

      .Cells(k, 1) = Split(dic, "|")(0) '''对应行号k的A列单元格，赋值拆分后的一个值

      .Cells(k, 2) = Split(dic, "|")(1) '''同上理，赋值第二个值

      .Cells(k, 3) = Split(dic, "|")(2) '''同上理，赋值第三个值

      .Cells(k, 4) = d.Item(dic) '''对应的item值，赋值给D列单元格

    Next '''结束for each循环

  End With '''with结束语句

  Erase arr '''释放arr数组

  Set d = Nothing '''释放字典d

End Sub '''工程结束

点击运行按钮，就可以完成操作。

代码里给大家也附上了注释，如果你想学习代码原理，这将是一个很好的过程。

写在最后：工作表需另存为.XLSM格式，否则代码会保存不上的。

好啦，以上就是今天的所有内容，感谢你的观看。

本文配套的练习课件请加入QQ群：902294808下载。

做Excel高手，快速提升工作效率，部落窝教育《一周Excel直通车》视频和《Excel极速贯通班》直播课全心为你！

扫下方二维码关注公众号，可随时随地学习Excel：

相关推荐：

如何提取唯一值？试试TEXTJOIN函数搭配VBA自定义！

别怕，VBA入门级教程来了，条件语句很简单！

Excel教程：如何制作带有层次和透视感的图表？

八大查找函数公式，轻松搞定数据中的多条件查找

版权申明：

本文作者E图表述；同时部落窝教育享有专有使用权。若需转载请联系部落窝教育。