复杂的多表汇总(难度有点大,做出来有分加哦)

thtfzhaobo · 发表于 2010-2-1 18:10

楼上代码已完成，对位写成模板格式，这里的人大部分都会，等大家完善

wenwen000424 · 发表于 2010-2-1 20:29

谢谢分享，表头有设置，左边分类列若也有设置就好了。用手头表格测试折腾了好长时间没有获得理想效果。见：http://club.excelhome.net/thread-524937-1-1.html

thtfzhaobo · 发表于 2010-2-2 01:13

左边一样处理了，只要选中拆分合并就可以

thtfzhaobo · 发表于 2010-2-2 14:29

如果左上角不是4个个合并，应可以；两行两列相同，没单独写，先合并吧，设置如下：

彭希仁 · 发表于 2010-2-2 14:58

原帖由 thtfzhaobo 于 2010-2-2 14:29 发表
如果左上角不是4个个合并，应可以；两行两列相同，没单独写，先合并吧，设置如下：

非常不错

thtfzhaobo · 发表于 2010-2-2 15:10

谢谢彭版鼓励，自用的工具，图方便，功能较杂，几种合并方式，可以根据关键字定位标题行，主要是数据层面的，未考虑报表类输出

wenwen000424 · 发表于 2010-2-2 18:27

感觉非常不错，的确再配上用关键字定位表头和表尾及行分类设置等可选项就是相当优秀的程序了。期待能继续完善并加以分享。支持。

thtfzhaobo · 发表于 2010-2-2 21:59

关键字定位标题行的功能是有的，没演示而已。
毕竟这是个合并工具，汇总的另外有，用于合并后汇总，合并的只写了求和

fssunnymen · 发表于 2010-2-3 17:52

Sub MyT()
Dim t
t = Timer
Dim arr, ara
Dim d As New Dictionary
Dim i As Integer, j As Integer, x As Integer, y As Integer
arr = Sheet1.Range("B1").CurrentRegion '把汇总表赋值给数组arr
For i = 4 To UBound(arr)
If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)
Next i
For i = 3 To UBound(arr, 2)
If Len(arr(2, i)) = 0 Then arr(2, i) = arr(2, i - 1)
Next i
'以上两个小循环意为去除合并单元格的后遗症
For j = 2 To Sheets.Count '循环总表外的其它工作表
ara = Sheets(j).Range("B1").CurrentRegion '将子工作表i赋值给数据ara
For i = 4 To UBound(ara)
      If Len(ara(i, 1)) = 0 Then ara(i, 1) = ara(i - 1, 1)
Next i
For i = 3 To UBound(ara, 2)
      If Len(ara(2, i)) = 0 Then ara(2, i) = ara(2, i - 1)
Next i
'以上两小循环也是同上(去除合并单元格的后遗症)
Dim mystr As String
For y = 3 To UBound(ara, 2)
      For x = 4 To UBound(ara)
         mystr = ara(x, 1) & "|" & ara(x, 2) & "|" & ara(2, y) & "|" & ara(3, y)
         d(mystr) = d(mystr) + ara(x, y)
      Next x
Next y
'将mystr即四个条件下的数值进行累加并写入数组
Erase ara '这个释放好像写不写都无所谓(好习惯,还是写上^_^)
Next j
'Stop'边写边调试
For y = 3 To UBound(arr, 2)
For x = 4 To UBound(arr)
      mystr = arr(x, 1) & "|" & arr(x, 2) & "|" & arr(2, y) & "|" & arr(3, y)
      arr(x, y) = d(mystr)
Next x
Next y
'在总表数组里进行字典对应填充(即四个条件符合者)
'Stop'边写边调试
Sheet1.Range("B1").CurrentRegion = arr '赋值出来给总表
'Stop'边写边调试
MsgBox Timer - t
End Sub

这样不知道对不对,,,,如果对了,好像就也不是太难....偶只是菜鸟(PS:字典我是直接添加引用scrrun.dll)
补充一下,如果再多几个条件的话,切记要改这里 mystr = ara(x, 1) & "|" & ara(x, 2) & "|" & ara(2, y) & "|" & ara(3, y)........

[ 本帖最后由 fssunnymen 于 2010-2-3 18:13 编辑 ]

wenwen000424 · 发表于 2010-2-3 19:44

原帖由 fssunnymen 于 2010-2-3 17:52 发表
Sub MyT()
Dim t
t = Timer
Dim arr, ara
Dim d As New Dictionary
Dim i As Integer, j As Integer, x As Integer, y As Integer
arr = Sheet1.Range("B1").CurrentRegion '把汇总表赋值给数组arr
For i = 4 ...

你可能没有阅读前面的帖子，还在重复前面的思路。不符合版主要求。

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

[讨论] 复杂的多表汇总(难度有点大,做出来有分加哦)

回复 1楼彭希仁的帖子

[讨论] 复杂的多表汇总(难度有点大,做出来有分加哦)

回复 1楼 彭希仁 的帖子

回复 1楼彭希仁的帖子