设为首页收藏本站
简字体切换切换到宽版

ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步，快速开始

快捷登录

搜索
ExcelHome技术论坛»论坛 › Excel 技术交流与问答 › Excel VBA程序开发 › 请大神帮忙，数据汇总统计，谢谢！
EH技术汇-专业的职场技能充电站 妙哉！函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器，一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理，一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12下一页
返回列表 发新帖
查看: 1911|回复: 11

[求助] 请大神帮忙，数据汇总统计，谢谢！

[复制链接]
suco681

TA的精华主题

TA的得分主题
发表于 2018-8-23 11:32 | 显示全部楼层 |阅读模式
[广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★

原始数据及要求如附件。

因为每月要统计这个数据，数据量比较大，20万行左右的原始数据，使用的是OFFICE 2010版本，请帮忙大神帮忙写个VBA代码，非常感谢！
大神, 帮忙, 数据, 数据汇

按日统计.rar

17.64 KB, 下载次数: 16
回复

举报

liulang0808

TA的精华主题

TA的得分主题
发表于 2018-8-23 14:16 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
  1. Sub 按钮1_Click()
  2.     arr = Sheets(1).UsedRange
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set dt = CreateObject("scripting.dictionary")
  5.     Set dd = CreateObject("scripting.dictionary")
  6.     ActiveSheet.UsedRange.Offset(1).ClearContents
  7.     brr = [a1].Resize(UBound(arr), 5)
  8.     Application.ScreenUpdating = False
  9.     a = 2
  10.     For j = UBound(arr) To 2 Step -1
  11.         If Len(arr(j, 16)) > 3 Then
  12.             If Mid(arr(j, 16), 2, 2) * 1 > 20 Then
  13.                 str1 = "虚拟出货"
  14.             Else
  15.                 str1 = Mid(arr(j, 16), 2, 2)
  16.             End If
  17.             If str1 <> "虚拟出货" Then dt(arr(j, 3)) = dt(arr(j, 3)) + arr(j, 14)
  18.             If d.exists(arr(j, 3) & "#" & str1) Then
  19.                 r = d(arr(j, 3) & "#" & str1)
  20.                 brr(r, 3) = arr(j, 14) + brr(r, 3)
  21.                 If InStr(dd(brr(r, 1)), arr(j, 4)) = 0 Then
  22.                     dd(brr(r, 1)) = dd(brr(r, 1)) & arr(j, 4) & ","
  23.                 End If
  24.             Else
  25.                 d(arr(j, 3) & "#" & str1) = a
  26.                 brr(a, 1) = arr(j, 3)
  27.                 brr(a, 2) = str1
  28.                 brr(a, 3) = arr(j, 14)
  29.                 dd(arr(j, 3)) = arr(j, 4) & ","
  30.                 a = a + 1
  31.             End If
  32.         End If
  33.     Next j
  34.     For j = 2 To a - 1
  35.         If brr(j, 2) <> "虚拟出货" Then
  36.             If dt.exists(brr(j, 1)) Then
  37.                 brr(j, 4) = UBound(Split(dd(brr(j, 1)), ","))
  38.                 brr(j, 5) = dt(brr(j, 1))
  39.                 dt.Remove brr(j, 1)
  40.                 dd.Remove brr(j, 1)
  41.             End If
  42.         End If
  43.     Next j
  44.     [a1].Resize(a - 1, 5) = brr
  45.     Application.ScreenUpdating = True
  46. End Sub
复制代码
回复

举报

liulang0808

TA的精华主题

TA的得分主题
发表于 2018-8-23 14:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
跟楼主的模拟结果有出入，

按日统计.zip

29.46 KB, 下载次数: 8
回复

举报

suco681

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-8-23 15:01 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
liulang0808 发表于 2018-8-23 14:17
跟楼主的模拟结果有出入，

订单数据统计不对
回复

举报

liulang0808

TA的精华主题

TA的得分主题
发表于 2018-8-23 15:03 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助★
suco681 发表于 2018-8-23 15:01
订单数据统计不对

跟模拟数据对不上
不知道楼主的工单是按照什么原则统计的
回复

举报

suco681

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-8-23 15:18 | 显示全部楼层
[广告] ★ ReportLite:表哥表姐早下班神器，专治各种报表不服，拒绝无意义的重复劳动 ★
liulang0808 发表于 2018-8-23 15:03
跟模拟数据对不上
不知道楼主的工单是按照什么原则统计的

出库单号 就是按日期统计不重复的单号个数。
回复

举报

liulang0808

TA的精华主题

TA的得分主题
发表于 2018-8-23 15:29 | 显示全部楼层
[广告] ★用Excel做企业管理系统，Excel服务器学习和下载★
suco681 发表于 2018-8-23 15:18
出库单号 就是按日期统计不重复的单号个数。
  1. Sub 按钮1_Click()
  2.     arr = Sheets(1).UsedRange
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set dt = CreateObject("scripting.dictionary")
  5.     Set dd = CreateObject("scripting.dictionary")
  6.     Sheets(2).Select
  7.     ActiveSheet.UsedRange.Offset(1).ClearContents
  8.     brr = [a1].Resize(UBound(arr), 5)
  9.     Application.ScreenUpdating = False
  10.     a = 2
  11.     For j = UBound(arr) To 2 Step -1
  12.         If Len(arr(j, 16)) > 3 Then
  13.             If Mid(arr(j, 16), 2, 2) * 1 > 20 Then
  14.                 str1 = "虚拟出货"
  15.             Else
  16.                 str1 = Mid(arr(j, 16), 2, 2)
  17.             End If
  18.             If str1 <> "虚拟出货" Then dt(arr(j, 3)) = dt(arr(j, 3)) + arr(j, 14)
  19.             
  20.             If d.exists(arr(j, 3) & "#" & str1) Then
  21.                 r = d(arr(j, 3) & "#" & str1)
  22.                 brr(r, 3) = arr(j, 14) + brr(r, 3)
  23.                 If InStr(dd(arr(j, 3)), arr(j, 4)) = 0 Then
  24.                     dd(arr(j, 3)) = dd(arr(j, 3)) & arr(j, 4) & ","
  25.                 End If
  26.             Else
  27.                 d(arr(j, 3) & "#" & str1) = a
  28.                 brr(a, 1) = arr(j, 3)
  29.                 brr(a, 2) = str1
  30.                 brr(a, 3) = arr(j, 14)
  31.                 If InStr(dd(arr(j, 3)), arr(j, 4)) = 0 Then
  32.                     dd(arr(j, 3)) = dd(arr(j, 3)) & arr(j, 4) & ","
  33.                 End If

  35.                 a = a + 1
  36.             End If
  37.         End If
  38.     Next j
  39.     For j = 2 To a - 1
  40.         If brr(j, 2) <> "虚拟出货" Then
  41.             If dt.exists(brr(j, 1)) Then
  42.                 brr(j, 4) = UBound(Split(dd(brr(j, 1)), ","))
  43.                 brr(j, 5) = dt(brr(j, 1))
  44.                 dt.Remove brr(j, 1)
  45.                 dd.Remove brr(j, 1)
  46.             End If
  47.         End If
  48.     Next j
  49.     [a1].Resize(a - 1, 5) = brr
  50.     Application.ScreenUpdating = True
  51. End Sub
复制代码
回复

举报

liulang0808

TA的精华主题

TA的得分主题
发表于 2018-8-23 15:30 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册★
之前的理解有误，供参考

按日统计.zip

29.58 KB, 下载次数: 10

评分

1

查看全部评分

回复

举报

suco681

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-8-23 17:04 | 显示全部楼层
[广告] ★Excel Home云课堂 - 专业的职场技能充电站★         ★Excel三大利器★        ★ 笨办法学VBA全系列★
liulang0808 发表于 2018-8-23 15:30
之前的理解有误，供参考

试过，验证数据是我想要的。感谢！
可否再帮忙增加一列数据：
   当前C列是工位出货数量（求和），可否在C列后面增加一列，工位出现的次数（计数）。

感谢大神！
AAA.jpg
回复

举报

suco681

TA的精华主题

TA的得分主题
 楼主| 发表于 2018-8-23 17:27 | 显示全部楼层
[广告] ★会Excel,就能做支持PC、手机、Web、App、Windows、安卓、IOS、Linux信息一体化的各种管理系统 ★
liulang0808 发表于 2018-8-23 15:30
之前的理解有误，供参考

试过，验证数据是我想要的。感谢！

可否再帮忙增加一列数据：
   当前C列是工位出货数量（求和），可否在C列后面增加一列，工位出现的次数（计数）。

感谢大神！
回复

举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-12 21:44 , Processed in 0.026581 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！     本站特聘法律顾问：李志群律师

快速回复 返回顶部 返回列表