怎样用数据字典进行汇总统计

weiguoyin868 · 发表于 2013-4-1 21:07

本帖最后由 weiguoyin868 于 2013-4-1 22:00 编辑

保险汇总台账.rar (10.83 KB, 下载次数: 97) 这两天研究院数据字典，觉得很有意思，想问用数据字典进行汇总统计是否方便，我工作需要对员工五险一金每月按人汇总，以前用的是函数,也用透视表，函数麻烦，透视表不灵活。上传文件里，有用函数统计实例，用透视统计统计实例。不知道数据字典统计怎样。求助一个数据字典的统计效果程序，使工作效率更高更快。

№①布鲑鲑 · 发表于 2013-4-1 21:11

每月按人汇总，难道说一个月里同一个人有可能出现两次以上？

weiguoyin868 · 发表于 2013-4-1 21:26

№①布鲑鲑发表于 2013-4-1 21:11
每月按人汇总，难道说一个月里同一个人有可能出现两次以上？

是我用词不当，是每人按月汇总，如：张三到2月份，保险项就是1月加2月，张三到2月份，保险项就是1月加2月加3月。

№①布鲑鲑 · 发表于 2013-4-1 22:51

weiguoyin868 发表于 2013-4-1 21:26
是我用词不当，是每人按月汇总，如：张三到2月份，保险项就是1月加2月，张三到2月份，保险项就是1月加2月 ...

Sub 汇总()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("基本表").UsedRange
ReDim brr(1 To UBound(arr), 1 To 13)
For i = 2 To UBound(arr)
If Not d.Exists(arr(i, 4)) Then
m = m + 1: n = 2
d(arr(i, 4)) = m: brr(m, 2) = 1
brr(m, 1) = arr(i, 4)
For j = 5 To UBound(arr, 2)
n = n + 1
brr(m, n) = arr(i, j)
Next
Else
brr(d(arr(i, 4)), 2) = brr(d(arr(i, 4)), 2) + 1
n = 2
For j = 5 To UBound(arr, 2)
n = n + 1
brr(d(arr(i, 4)), n) = brr(d(arr(i, 4)), n) + arr(i, j)
Next
End If
Next
Sheets("明细汇总").Range("a2").Resize(m, n) = brr
End Sub

复制代码

weiguoyin868 · 发表于 2013-4-1 22:59

本帖最后由 weiguoyin868 于 2013-4-1 23:06 编辑

№①布鲑鲑发表于 2013-4-1 22:51

运行不通，提示下标越界，怎么回事。能否在上传文件里运行，再传给我。

№①布鲑鲑 · 发表于 2013-4-1 23:06

weiguoyin868 发表于 2013-4-1 22:59
运行不通，提示下标越界，怎么回事。能否在上传文件里运行，再传给我。

保险汇总台账.rar (11.87 KB, 下载次数: 416)

weiguoyin868 · 发表于 2013-4-1 23:10

本帖最后由 weiguoyin868 于 2013-4-1 23:12 编辑

№①布鲑鲑发表于 2013-4-1 23:06

嗯很不错，没想到，数据字典统计速度很快，代码也少，目前也不理解原理，我要好好学习。

№①布鲑鲑 · 发表于 2013-4-1 23:12

weiguoyin868 发表于 2013-4-1 23:10
嗯很不错，没想到，数据字典统计速度很快。我要好好学习。

你都技术10了，怎么还要学字典哦

netfly168 · 发表于 2013-4-2 17:16

学习了，路过

mjzxlmg · 发表于 2013-4-2 18:05

本帖最后由 mjzxlmg 于 2013-4-2 18:06 编辑

[code=vb]Sub Sum()
Dim dic As Object, arr, result(), i&, j&, m&, s&
Set dic = CreateObject("scripting.dictionary") '定义字典
arr = Sheet1.[a1].CurrentRegion.Value             '将工作表数据装入数组ＡＲＲ
ReDim result(1 To UBound(arr), 1 To UBound(arr, 2) - 2) '重新声明结果动态数组result的大小
result(1, 1) = arr(1, 4): result(1, 2) = "月数"       '以下将标题写入输出数组result
For j = 5 To UBound(arr, 2)
      result(1, j - 2) = arr(1, j)
Next
m = 1
For i = 2 To UBound(arr)    '在数组ＡRR中循环
      s = dic(Trim(arr(i, 4)))
      If s = Empty Then
         m = m + 1
         dic(Trim(arr(i, 4))) = m    '将姓名作为关键字装入字典dic,累计姓名数量作为对应项
         s = m                         '替换
         result(s, 1) = Trim(arr(i, 4))    '输出数组的第一列为姓名
      End If
      result(s, 2) = result(s, 2) + 1    '输出数组的第二列月份累计数
      For j = 5 To UBound(arr, 2)
         If Len(arr(i, j)) Then result(s, j - 2) = result(s, j - 2) + arr(i, j)       '输出数组的其余列为累加
      Next
Next
If m > 1 Then  '如果存在关键字
      With Sheet3 '结果写入ＳＨＥＥＴ3
         .UsedRange.ClearContents    '清空工作表数据
         With .[a1].Resize(m, UBound(result, 2))
            .Value = result          '将数据写入工作表Ａ1开始的区域
            .Font.Size = 10          '字号设定为10磅
            .Borders.LineStyle = 1    '加入边框
            .Columns.AutoFit          '自定调整列宽
         End With
      End With
End If
Set dic = Nothing    '释放字典
End Sub[/code]

测试附件：

保险汇总台账.rar (16.92 KB, 下载次数: 519)

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

[求助] 怎样用数据字典进行汇总统计

评分