字典嵌套应用一例——拆分数据到分表

zhaogang1960 · 发表于 2013-2-3 21:17

本帖最后由 zhaogang1960 于 2013-2-18 22:36 编辑

前几日回复了一个问题，按照“营业厅”字段，将“辅助列”数据拆分数据到分表，要求按照“科目名称”中的一级、二级科目和分表中的“辅助列”对齐。原题目如下：
将原始数据表中的辅助列的数字，分别填到对应的分表大东，大东一，大东二中，原始数据科目名称要和分表中的辅助列明细相对应，月份也需要对应
http://club.excelhome.net/thread-977947-5-1.html

下面采用字典嵌套拆分，希望能对相似题目有指导作用：

Sub Macro1()
Dim d As Object, ds As Object, sh As Worksheet, a, arr, brr, i&, j&, l&, s$, t, temp$
Set d = CreateObject("scripting.dictionary") '创建字典对象
arr = Sheets("原始数据").Range("A1").CurrentRegion '数据写入数组
For i = 2 To UBound(arr) '逐列数据
If Len(arr(i, 2)) Then '如果营业厅列不为空
If Not d.Exists(arr(i, 2)) Then Set d(arr(i, 2)) = CreateObject("scripting.dictionary") '创建该营业厅字典对象
If Len(arr(i, 3)) = 4 Then '如果科目编码为4位数，即为一级科目
d(arr(i, 2))(arr(i, 4)) = d(arr(i, 2))(arr(i, 4)) & "," & i '一级科目对应的“科目名称”添加到字典键值，即字典记住行号
temp = arr(i, 4) '一级科目对应的“科目名称”
Else '二级科目
d(arr(i, 2))(temp & Chr(9) & arr(i, 4)) = d(arr(i, 2))(temp & Chr(9) & arr(i, 4)) & "," & i ''一级科目对应的“科目名称”和二级科目连接后添加到字典键值，字典记住行号
End If
End If
Next
k = d.Keys '字典键值写入数组k，即不重复的营业厅
On Error Resume Next '避免不重复的营业厅对应的工作表不存在时出错提示
For l = 0 To d.Count - 1 '逐个营业厅
Set sh = Sheets(k(l)) '把该营业厅工作表赋值给变量sh
If Not sh Is Nothing Then '
Set ds = d(k(l)) 'ds是个临时变量，代表该营业厅的字典对象，为了书写方便
With sh.Range("A3").CurrentRegion '分表数据区域
.Offset(1, 3).ClearContents '清除原数据
brr = .Value '写入数组
For i = 2 To UBound(brr) '逐行
If Len(brr(i, 1)) Then '如果第一列不为空，即为一级科目
s = brr(i, 1) '临时变量记住一级科目
temp = s '同上
Else '二级科目
s = temp & Chr(9) & brr(i, 3) '一级科目连接二级科目
End If
t = ds(s) '字典条目
If t <> "" Then '字典存在
a = Split(t, ",") '拆分行号
For j = 1 To UBound(a) '逐个行号
brr(i, arr(a(j), 1) + 3) = arr(a(j), 7) '月份对应的列写入辅助列数值
Next
End If
Next
.Value = brr '处理后的数组写回数据区域
End With
End If
Next
End Sub

复制代码

字典套字典按照营业厅将一级项目和二级项目拆分到分表.rar (24.84 KB, 下载次数: 1577)

该贴已经同步到 zhaogang1960的微博

liuyuyu880210 · 发表于 2013-2-4 01:28

本帖最后由 liuyuyu880210 于 2013-2-4 01:31 编辑

又学习了，谢谢赵老师，正是我需要的，手里正好有这样的工作啊谢谢啊

dybg · 发表于 2013-2-4 03:11

谢谢了，下载收藏，学习领会。

panan12301 · 发表于 2013-2-4 08:22

谢谢分享学习了。

cqcbc · 发表于 2013-2-18 22:21

版主,用了一下,不对,机场发货费、机场提货费怎么都与一级科目的金额相同了？1月、2月均如此，请版主检查一下。

zhaogang1960 · 发表于 2013-2-18 22:34

本帖最后由 zhaogang1960 于 2013-2-18 22:38 编辑

cqcbc 发表于 2013-2-18 22:21
版主,用了一下,不对,机场发货费、机场提货费怎么都与一级科目的金额相同了？1月、2月均如此，请版主检查一下 ...

谢谢提醒，没有考虑各分表辅助列空单元格的影响，加一个分隔符Chr(9)：

d(arr(i, 2))(temp & Chr(9) & arr(i, 4)) = d(arr(i, 2))(temp & Chr(9) & arr(i, 4)) & "," & i
s = temp & Chr(9) & brr(i, 3)

复制代码

1楼代码和附件已经更新

zhaogang1960 · 发表于 2013-2-18 22:51

新加功能:

各分表中每个科目占用2列，其中第二列为所占比例，计算公式为：
公式为
=E5/$D$4
=E6/$D$4
=E7$D$4
=E8/$D$4
.....................以此类推

字典套字典按照营业厅将一级项目和二级项目拆分到分表(扩展)—计算所占比例.rar (75.68 KB, 下载次数: 433)

cqcbc · 发表于 2013-2-20 12:00

不错,再次请问:如果要拆分1-12月的数据,如何修改代码,谢谢.

zhaogang1960 · 发表于 2013-2-20 12:32

cqcbc 发表于 2013-2-20 12:00
不错,再次请问:如果要拆分1-12月的数据,如何修改代码,谢谢.

本例不同于一般拆分，需要把分表做好——即向分表拆分数据

xuyeshun1226 · 发表于 2013-2-20 14:14

赵老师这字典数组用的真是牛~

		自动登录	找回密码
密码			免费注册

[分享] 字典嵌套应用一例——拆分数据到分表

评分

评分