首页
- 全部课程
- 视频
- 图文教程
- 教学动态
- 设计资讯
- 学员天地
- 图文教程 >
- 电脑与办公教程 >
- EXCEL >
- VBA教程:如何将一个二维表转为一维表?
VBA教程:如何将一个二维表转为一维表?
作者:E图表述来源:部落窝教育发布时间:2022-09-28 16:05:16点击:1462
编按:
哈喽,大家好,在之前的教程中给大家分享过如何用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图表述;同时部落窝教育享有专有使用权。若需转载请联系部落窝教育。
最热教程
- 像绿皮火车一样长像珠穆拉玛峰一样高的Excel表怎么操作才方便?
- Power Query实战:按指定次数递增数据
- 2019年全网最全—excel提取身份证信息合集!(建议收藏)-下篇
- 明明没有重复,Excel却判定数据重复,这是怎么回事?
- 文本格式的求和,及求和中最容易出现的问题解疑
- 致命缺陷:不懂一维表!
- 函数组合思维,你有吗?
- 学会这2个公式,整理考勤数据只要一分钟
- 就算被说是拍马屁也成,今天你应该这样发Excel报表……
- 如何计算Excel单元格中的算式,四种求和方法请收好!
最新教程
- 用LAMBDA自定义颜色求和函数
- 用SUMIF错位求和多表求和与查找
- BYROW和BYCOL函数用法详解
- makearray函数用法6例
- PDF转Excel表格的两种免费方法
- Excel加PPT三步完成图片批量加水印
- SCAN函数基本用法和典型应用
- MAP函数如何使用?有何意义?
- 简单6步完成Excel气泡地图
- 如何理解和使用REDUCE函数?