ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 所有工作表取不重复项作为资料库提取到汇总表

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-8 23:06 | 显示全部楼层 |阅读模式
怎么实现:   所有工作表取不重复项作为资料库提取到汇总表

谢谢
111.jpg

工作簿2.rar

9.34 KB, 下载次数: 20

TA的精华主题

TA的得分主题

发表于 2019-9-8 23:27 | 显示全部楼层
不重复,用字典

不过你这里对重复关键词的有个矛盾:
sheet1里 重复项 面油20ML白色, 数量100和50,你汇总后 是50?(以后者为准?)
sheet1(2)里重复项 护手100ML白色,数量20 和100,你汇总后是20?(以前者为准?)
还是说数量应该是所有重复项的数量汇总累加?



头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-9-9 00:09 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-9-9 00:12 | 显示全部楼层
  1. Sub 字典()
  2. Dim d, sh, arr(), brr(), y, k, i, j
  3. Set d = CreateObject("Scripting.Dictionary") '字典
  4. For sh = 2 To Sheets.Count
  5. arr = Sheets(sh).Range("A2:H" & Sheets(sh).Cells(Rows.Count, 1).End(xlUp).Row).Value
  6. For i = 1 To UBound(arr)
  7. If Not d.exists(arr(i, 3) & "!" & arr(i, 4) & "!" & arr(i, 5)) Then
  8. d(arr(i, 3) & "!" & arr(i, 4) & "!" & arr(i, 5)) = arr(i, 1) & "!" & arr(i, 2) & "!" & arr(i, 6) & "!" & arr(i, 7) & "!" & arr(i, 8)
  9. Else
  10. y = Split(d(arr(i, 3) & "!" & arr(i, 4) & "!" & arr(i, 5)), "!")(2) + arr(i, 6)
  11. d(arr(i, 3) & "!" & arr(i, 4) & "!" & arr(i, 5)) = arr(i, 1) & "!" & arr(i, 2) & "!" & y & "!" & arr(i, 7) & "!" & arr(i, 8)
  12. End If
  13. Next i
  14. Next

  15. ReDim brr(1 To d.Count, 1 To 8)
  16. For Each k In d.keys
  17. j = j + 1
  18. brr(j, 1) = Split(d(k), "!")(0)
  19. brr(j, 2) = Split(d(k), "!")(1)
  20. brr(j, 3) = Split(k, "!")(0)
  21. brr(j, 4) = Split(k, "!")(1)
  22. brr(j, 5) = Split(k, "!")(2)
  23. brr(j, 6) = Split(d(k), "!")(2)
  24. brr(j, 7) = Split(d(k), "!")(3)
  25. 'brr(j, 8) = Split(d(k), "!")(4)
  26. Next
  27. Sheets("汇总").[A2].Resize(j, 8) = brr
  28. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2019-9-9 03:12 | 显示全部楼层
  1. Option Explicit

  2. Sub test()
  3.   Dim arr, crr, i, j, k, m, p, sht, cnt, sum
  4.   ReDim brr(1 To 10 ^ 3, 1 To 9)
  5.   crr = brr
  6.   For Each sht In Sheets
  7.     If sht.Name <> "汇总" Then
  8.       With sht
  9.         arr = .[a1].CurrentRegion.Resize(, 9)
  10.       End With
  11.       For i = 2 To UBound(arr, 1)
  12.         m = m + 1
  13.         For j = 1 To UBound(arr, 2) - 1
  14.           brr(m, j) = arr(i, j)
  15.         Next
  16.         brr(m, j) = arr(i, 3) & arr(i, 4) & arr(i, 5)
  17.       Next
  18.     End If
  19.   Next
  20.   Call bsort(brr, 1, m, 1, UBound(brr, 2), 9)
  21.   For i = 1 To m
  22.     sum = sum + brr(i, 8)
  23.     If brr(i, 9) <> brr(i + 1, 9) Then
  24.       If i - p > 1 Then Call bsort(brr, p + 1, i, 1, UBound(brr, 2), 1)
  25.       cnt = cnt + 1
  26.       For j = 1 To UBound(brr, 2) - 2
  27.         brr(cnt, j) = brr(p + 1, j)
  28.       Next
  29.       brr(cnt, j) = sum: sum = 0: p = i
  30.     End If
  31.   Next
  32.   With Sheets("汇总").[a2]
  33.     .Resize(Rows.Count - 1, UBound(brr, 2) - 1).ClearContents
  34.     .Resize(cnt, UBound(brr, 2) - 1) = brr
  35.   End With
  36. End Sub

  37. Function bsort(arr, first, last, left, right, key)
  38.   Dim i, j, k, t
  39.   For i = first To last - 1
  40.     For j = first To last + first - 1 - i
  41.       If arr(j, key) < arr(j + 1, key) Then
  42.         For k = left To right
  43.           t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
  44.         Next
  45.       End If
  46.     Next
  47.   Next
  48. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2019-9-9 07:05 | 显示全部楼层
python pandas写的,参考
  1. import pandas as pd
  2. df=pd.concat(pd.read_excel('工作簿2.xlsx'),sheet_name=None),ignore_index=True) #读取文件不要包含汇总表

  3. df=df.drop_duplicates(['品名','规格','颜色'],keep='first')

  4. df.to_excel('result.xlsx',index=False)
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-9 07:47 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-9 08:02 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-9 08:03 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-9 08:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

  感谢你的回答,,,运行时错误13类型不匹配...还有有空行也不行
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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