excel 实现更为普遍的二维报表整理为数据清单的方法
时间:2022-02-02 23:19:16
下面1图所示的二维报表数据。这种表格设计的初衷是为了方便输入数据,但是却为数据汇总和分析造成了麻烦。例如,要统计办公室的复印纸的耗量和费用,就比较麻烦。对于这样的表格,最后将其设计为日记流水账的形式,如图2所示。尽管在输入数据时有些麻烦,但统计汇总分析就很方便。
那么如何将图1所示的二维表格转换为图2所示的规范表格呢,利用函数也是很复杂的,可以利用VBA编制程序比较方便。下面就是相关的VBA程序代码。
Public Sub DataList()
Dim myArray As Variant
Dim n As Long, i As Long, k As Long, j As Long
Dim ws0 As Worksheet
Dim wsNew As Worksheet
myArray = Array("日期", "材料", "单位", "部门", "数量", "金额")
Set ws0 = Worksheets("不科学表格")
n = ws0.Range("A65536").End(xlUp).Row - 2
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("数据清单").Delete
Application.DisplayAlerts = False
On Error GoTo 0
Set wsNew = Worksheets.Add
With wsNew
.Name = "数据清单"
.Range("A1:F1") = myArray
k = 1
For j = 4 To 8 Step 2
For i = 1 To n
If ws0.Cells(i + 2, j) <> "" Then
.Cells(k + 1, 1) = Format(ws0.Cells(i + 2, 1), "yyyy-m-d")
.Cells(k + 1, 2) = ws0.Cells(i + 2, 2)
.Cells(k + 1, 3) = ws0.Cells(i + 2, 3)
.Cells(k + 1, 4) = ws0.Cells(1, j)
.Cells(k + 1, 5) = ws0.Cells(i + 2, j)
.Cells(k + 1, 6) = ws0.Cells(i + 2, j + 1)
k = k + 1
End If
Next i
Next j
End With
Set ws0 = Nothing
Set wsNew = Nothing
End Sub
只要运行上面代码,就可以迅速的将二维报表数据转换为数据清单。现在就可以利用整理好的“数据清单”制作数据透视表。
![](/images/zang.png)
![](/images/jiucuo.png)
猜你喜欢
Excel经典使用技巧汇总
![](https://img.aspxhome.com/file/2023/3/36373_0s.jpg)
Win10待机后无法唤醒固态硬盘怎么办?
![](https://img.aspxhome.com/file/2023/6/51606_0s.jpg)
word文档怎样转换成印刷模式
![](https://img.aspxhome.com/file/2023/8/18828_0s.png)
在word中怎么删除分页符?怎么在word中显示分页符?
![](https://img.aspxhome.com/file/2023/6/29226_0s.png)
如何用word2003画虚线的曲线图?
![](https://img.aspxhome.com/file/2023/1/18711_0s.png)
excel表格开头的0怎么打
win10系统如何在任务栏上面显示个性名称?win10系统任务栏显示个性名称的方法
![](https://img.aspxhome.com/file/2023/4/46694_0s.png)
Windows10无法打开CMD命令提示符窗口怎么办?
![](https://img.aspxhome.com/file/2023/8/49958_0s.png)
word怎么给文本框填充渐变色
![](https://img.aspxhome.com/file/2023/6/31826_0s.jpg)
word文档如何将文字倒过来
Win10电脑显示器刷新率怎么调?Win10专业版显示器刷新率调整方法
![](https://img.aspxhome.com/file/2023/9/48869_0s.jpg)
Excel条件格式有多强,你绝对想不到可以这么用!
![](https://img.aspxhome.com/file/2023/2/38862_0s.gif)
怎么设置wps自动更新时间
![](https://img.aspxhome.com/file/2023/6/a163956_0s.jpg)
Win10显卡赫兹如何修改?Win10修改显卡赫兹方法
![](https://img.aspxhome.com/file/2023/1/49921_0s.jpg)
Win10专业版系统如何打开rar文件?Win10专业版系统rar文件的正确打开方式
![](https://img.aspxhome.com/file/2023/9/49569_0s.png)
excel怎么制作直方图
outlook2010 签名 Outlook2010如何设置签名
![](https://img.aspxhome.com/file/2023/8/15698_0s.jpg)
小而美的函数之SMALL函数
![](https://img.aspxhome.com/file/2023/1/a142561_0s.png)
如何利用excel 2013数据筛选功能批量删除空行
![](https://img.aspxhome.com/file/2023/4/a154214_0s.png)