设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 求姓名与产量之和
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2808|回复: 4

[已解决]求姓名与产量之和

[复制链接]
发表于 2015-5-7 22:12 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 张雄友 于 2015-5-8 12:53 编辑

求姓名与产量之和，增加二列内容。
最佳答案
月排行榜 / 总排行榜
grf1973
2015-5-8 10:41
  1. Sub grf()
  2.     '第2列工号，第3列姓名，第8列制单号，第11列工序名称，第14列产量！
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     arr = Sheets("交飞明细").Range("A1").CurrentRegion
  6.     ReDim brr(1 To UBound(arr), 1 To 100)
  7.     For i = 2 To UBound(arr)
  8.         x = arr(i, 2): cl = arr(i, 14)
  9.         zf = arr(i, 8) & " " & arr(i, 11) & " " & cl       '工号+工序名称+产量
  10.         If Not d.Exists(x) Then
  11.             s = s + 1
  12.            d(x) = s
  13.            brr(s, 1) = arr(i, 2)
  14.            brr(s, 2) = arr(i, 3)
  15.            brr(s, 3) = cl      '产量
  16.            brr(s, 4) = zf      '工号+工序名称+产量
  17.         Else
  18.            n = d(x)
  19.            brr(n, 3) = brr(n, 3) + cl
  20.            brr(n, 4) = brr(n, 4) & "," & zf        '先把所有   工号+工序名称+产量 全部放入第4列
  21.         End If
  22.     Next
  23.     d.RemoveAll
  24.    
  25.     For i = 1 To s
  26.         xrr = Split(brr(i, 4), ",")    '对第4列进行分析
  27.         For j = 0 To UBound(xrr)
  28.             y = xrr(j)
  29.             yrr = Split(y, " ")
  30.             gx = yrr(1)          '工序名称
  31.             If Not d.Exists(gx) Then
  32.                 d(gx) = Val(yrr(2))        '产量
  33.                 d1(gx) = yrr(0)          '工号
  34.             Else
  35.                 d(gx) = d(gx) + Val(yrr(2))
  36.                 If InStr(d1(gx), yrr(0)) = 0 Then d1(gx) = d1(gx) & "/" & yrr(0)
  37.             End If
  38.         Next
  39.         For Each gx In d.Keys
  40.             If InStr(d1(gx), "/") > 0 Then d1(gx) = "(" & d1(gx) & ")"    '如果有"/"，就加上括号
  41.             k = k + 1: If 3 + k > maxk Then maxk = 3 + k   '最大列
  42.             brr(i, 3 + k) = d1(gx) & " " & gx & " " & d(gx) & "件"
  43.         Next
  44.         d.RemoveAll
  45.         d1.RemoveAll
  46.         k = 0
  47.     Next
  48.     [a14].Resize(s, maxk) = brr
  49. End Sub
复制代码
姓名

2.rar

16.69 KB, 下载次数: 8

相关帖子

excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
 楼主| 发表于 2015-5-8 06:31 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
自己顶一下。
回复

使用道具 举报

grf1973
发表于 2015-5-8 10:41 | 显示全部楼层    本楼为最佳答案   
工作中最常用的Excel函数公式，全印在一张鼠标垫上
  1. Sub grf()
  2.     '第2列工号，第3列姓名，第8列制单号，第11列工序名称，第14列产量！
  3.     Set d = CreateObject("scripting.dictionary")
  4.     Set d1 = CreateObject("scripting.dictionary")
  5.     arr = Sheets("交飞明细").Range("A1").CurrentRegion
  6.     ReDim brr(1 To UBound(arr), 1 To 100)
  7.     For i = 2 To UBound(arr)
  8.         x = arr(i, 2): cl = arr(i, 14)
  9.         zf = arr(i, 8) & " " & arr(i, 11) & " " & cl       '工号+工序名称+产量
  10.         If Not d.Exists(x) Then
  11.             s = s + 1
  12.            d(x) = s
  13.            brr(s, 1) = arr(i, 2)
  14.            brr(s, 2) = arr(i, 3)
  15.            brr(s, 3) = cl      '产量
  16.            brr(s, 4) = zf      '工号+工序名称+产量
  17.         Else
  18.            n = d(x)
  19.            brr(n, 3) = brr(n, 3) + cl
  20.            brr(n, 4) = brr(n, 4) & "," & zf        '先把所有   工号+工序名称+产量 全部放入第4列
  21.         End If
  22.     Next
  23.     d.RemoveAll
  24.    
  25.     For i = 1 To s
  26.         xrr = Split(brr(i, 4), ",")    '对第4列进行分析
  27.         For j = 0 To UBound(xrr)
  28.             y = xrr(j)
  29.             yrr = Split(y, " ")
  30.             gx = yrr(1)          '工序名称
  31.             If Not d.Exists(gx) Then
  32.                 d(gx) = Val(yrr(2))        '产量
  33.                 d1(gx) = yrr(0)          '工号
  34.             Else
  35.                 d(gx) = d(gx) + Val(yrr(2))
  36.                 If InStr(d1(gx), yrr(0)) = 0 Then d1(gx) = d1(gx) & "/" & yrr(0)
  37.             End If
  38.         Next
  39.         For Each gx In d.Keys
  40.             If InStr(d1(gx), "/") > 0 Then d1(gx) = "(" & d1(gx) & ")"    '如果有"/"，就加上括号
  41.             k = k + 1: If 3 + k > maxk Then maxk = 3 + k   '最大列
  42.             brr(i, 3 + k) = d1(gx) & " " & gx & " " & d(gx) & "件"
  43.         Next
  44.         d.RemoveAll
  45.         d1.RemoveAll
  46.         k = 0
  47.     Next
  48.     [a14].Resize(s, maxk) = brr
  49. End Sub
复制代码

2.rar

18.83 KB, 下载次数: 10

点评

张雄友
http://www.excelpx.com/thread-342802-1-2.html  发表于 2015-5-14 18:28
回复

使用道具 举报

 楼主| 发表于 2015-5-13 13:20 | 显示全部楼层
grf1973 发表于 2015-5-8 10:41

实现《效果》。

加多一列和1.rar

414.39 KB, 下载次数: 9
回复

使用道具 举报

grf1973
发表于 2015-5-15 10:19 | 显示全部楼层
。。。。。。。。。。。

加多一列和1.rar

412.59 KB, 下载次数: 5

评分

参与人数 1 +9 收起 理由
张雄友 + 9 很给力!

查看全部评分

回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-24 12:28 , Processed in 0.627253 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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