ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4598|回复: 30

[求助] 条件汇总

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-2-27 12:13 | 显示全部楼层 |阅读模式
求助:
1.表1是详细表(即流水表),希望在表2中汇总每个员工的工序次数等情况,
2.汇总的要求是首先按照月份筛选,其次按照工艺(即包装工艺不筛选),最后筛选的结果求和填入表中,
3.需要将表2中姓名列中的名字循环完毕,即每个人都要汇总完毕
4.汇总的数据是姓名筛选时使用模糊筛选,即单独作业,配合作业,都算此人的次数,当日的名字出现3次及以上才计算为1次,计算整个月的合计,如7月1日,某某名字出现4次,7月2次,名字又出现3次,其余当月日期都没有出现超过3次,那么这个人整月的换工序次数为2
5.NPI次数根据产品编号和类型,同一个产品编号,只要类型是NPI,就计算为1次。

工作簿1.rar

11.7 KB, 下载次数: 27

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-27 15:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-2-27 15:37 | 显示全部楼层
你再说的详细一些,比如聂彬的工艺,如果是包装那就不算?还有姓名那列最好是单一的人员

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-28 13:47 | 显示全部楼层
donghui2363 发表于 2020-2-27 15:37
你再说的详细一些,比如聂彬的工艺,如果是包装那就不算?还有姓名那列最好是单一的人员

是的,包装是剔除的,那个位置填什么,就不计算什么,
人姓名的话这个没办法单一,如果是单一的我也会弄成单一的,有些工序就是几个人组合着做的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-2-28 13:49 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
大神们帮忙看看

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-2 13:51 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-3-2 15:34 | 显示全部楼层
  1. Sub 模糊多条件汇总()
  2.     Dim arr, brr, d As Object, r%, i&, x%, m&, y&, s$
  3.     Dim k As Variant
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Application.ScreenUpdating = False
  6.     r = Range("a65536").End(3).Row
  7.     arr = Range("a5:d" & r)
  8.     With Sheet1
  9.         r = .Range("a65536").End(3).Row
  10.         brr = .Range("a4:m" & r)
  11.     End With
  12.     For i = 1 To UBound(arr)
  13.         d(brr(i, 1)) = ""
  14.     Next
  15.     For i = 1 To UBound(arr)
  16.         s = arr(i, 1)
  17.         For Each k In d.keys
  18.             For x = 1 To UBound(brr)
  19.                 If InStr(brr(x, 2), s) Then
  20.                     If brr(x, 1) = k And brr(x, 9) <> "包装" Then
  21.                         m = m + 1
  22.                         If m≥3 Then
  23.                              y = 1
  24.                         End If
  25.                     End If
  26.                     If brr(x, 13) = "NPI" Then
  27.                        arr(i, 3) = arr(i, 3) + 1
  28.                     End If
  29.                 End If
  30.             Next
  31.             arr(i, 2) = arr(i, 2) + y
  32.         Next
  33.     Next
  34.     [a23].Resize(UBound(arr), 3) = arr
  35.     Set d = Nothing
  36.     Application.ScreenUpdating = True
  37. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-2 15:54 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

非常感谢前辈的帮助,测试发现结果和模拟的结果不一致,结果是全零
能再帮忙看看吗,姓名列中有组合的人员,是否需要使用类似Split来拆分。

TA的精华主题

TA的得分主题

发表于 2020-3-3 12:50 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

。。。。。。。。。。。。。。。。。。。。

工作簿1.rar

23.9 KB, 下载次数: 20

TA的精华主题

TA的得分主题

发表于 2020-3-3 13:16 | 显示全部楼层
huanhuaexcel 发表于 2020-3-2 15:54
非常感谢前辈的帮助,测试发现结果和模拟的结果不一致,结果是全零
能再帮忙看看吗,姓名列中有组合的人 ...
  1. Sub 模糊多条件汇总()
  2.     Dim arr, brr, d As Object, d2 As Object, r%, i&, x%, m&, y&, s$
  3.     Dim k As Variant
  4.     Set d = CreateObject("scripting.dictionary")
  5.     Set d2 = CreateObject("scripting.dictionary")
  6.     Application.ScreenUpdating = False
  7.     生成不重复值姓名
  8.     r = Range("a65536").End(3).Row
  9.     arr = Range("a5:d" & r)
  10.     With Sheet1
  11.         r = .Range("a65536").End(3).Row
  12.         brr = .Range("a4:m" & r)
  13.     End With
  14.     For i = 1 To UBound(brr)
  15.         d(brr(i, 1)) = ""
  16.     Next
  17.     For i = 1 To UBound(arr)   '姓名
  18.         s = arr(i, 1)
  19.         For Each k In d.keys   '月份
  20.             For x = 1 To UBound(brr)
  21.                 If InStr(brr(x, 3), s) Then
  22.                     If brr(x, 1) = 1 * k And brr(x, 9) <> "包装" Then
  23.                         m = m + 1
  24.                     End If
  25.                 End If
  26.             Next
  27.             If m > 2 Then
  28.                 y = y + 1
  29.                 m = 0
  30.             End If
  31.         Next
  32.         arr(i, 2) = y
  33.         m = 0
  34.         y = 0
  35.         For x = 1 To UBound(brr)
  36.             If InStr(brr(x, 3), s) And brr(x, 13) = "NPI" Then
  37.                 d2(brr(x, 7)) = d2(brr(x, 7)) & brr(i, 8) & ","
  38.             End If
  39.          Next
  40.         arr(i, 3) = d2.Count
  41.         d2.RemoveAll
  42.     Next
  43.     [a5].Resize(UBound(arr), 3) = arr
  44.     Set d = Nothing
  45.     Set d2 = Nothing
  46.     Application.ScreenUpdating = True
  47. End Sub

  48. Sub 生成不重复值姓名()
  49.     Dim arr, trr, brr(), sa, d, s$, t$, r&, i&, x&, n&
  50.     Set d = CreateObject("scripting.dictionary")
  51.     With Sheet1
  52.         r = .Range("a65536").End(3).Row
  53.         arr = .Range("a4:m" & r)
  54.     End With
  55.     ReDim trr(1 To 500, 1 To 1)
  56.     For i = 1 To UBound(arr)
  57.         s = arr(i, 3)
  58.         If s <> "" Then
  59.             If InStr(s, "/") Then
  60.                 sa = Split(s, "/")
  61.                 For x = 0 To UBound(sa)
  62.                     n = n + 1
  63.                     trr(n, 1) = sa(x)
  64.                 Next
  65.             Else
  66.                 n = n + 1
  67.                 trr(n, 1) = s
  68.             End If
  69.         End If
  70.     Next
  71.     ReDim brr(1 To UBound(trr), 1 To 1)
  72.     For i = 1 To UBound(trr)
  73.         t = Trim(CStr(trr(i, 1)))
  74.         If t <> "" And Not d.exists(t) Then
  75.             d(t) = ""
  76.             brr(d.Count, 1) = t
  77.         End If
  78.     Next i
  79.     If d.Count > 0 Then [a5].Resize(d.Count, 1) = brr
  80.     Set d = Nothing
  81. End Sub
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 23:01 , Processed in 0.048565 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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