ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 ExcelHome出品 - VBA代码宝免费下载 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 284|回复: 20

[求助] 提取店名,并根据店名求和

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-1-11 08:45 | 显示全部楼层 |阅读模式
本帖最后由 chenbenhai 于 2019-1-11 09:19 编辑

求助:将本文件夹内<汇总>文件外的其他文件内‘数据’表里的店铺名称(唯一性,重复的店名提取一个)提取到<汇总>表的‘数据’单元格A1里,并将数量和金额求和。多谢

表.rar

25.01 KB, 下载次数: 37

TA的精华主题

TA的得分主题

发表于 2019-1-11 09:51 | 显示全部楼层
不管类型吗 你的每个表的字段名不一样吗?

TA的精华主题

TA的得分主题

发表于 2019-1-11 09:54 | 显示全部楼层
如果表给完全一样就好整的多 就是一个字典加遍历所有文件就完事 没有难度 如果每个表的字段不同 就要复杂些

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 10:06 | 显示全部楼层
汇总表里只要 店铺名称        代码        数量        金额 四个字段 1月表里的类型不提取

TA的精华主题

TA的得分主题

发表于 2019-1-11 10:31 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 11:11 | 显示全部楼层
本帖最后由 chenbenhai 于 2019-1-11 11:34 编辑

多谢 版主 ,谢谢

TA的精华主题

TA的得分主题

发表于 2019-1-11 11:26 | 显示全部楼层
chenbenhai 发表于 2019-1-11 10:06
汇总表里只要 店铺名称        代码        数量        金额 四个字段 1月表里的类型不提取
  1. Sub 同夹_多薄_首表_AB分类_BC汇总_字典法参考()
  2.     Dim 结果数组(1 To 65536, 1 To 256)
  3.     Set 字典 = CreateObject("scripting.dictionary")
  4.     路径 = ThisWorkbook.Path & ""
  5.     本薄 = ThisWorkbook.Name
  6.     外薄 = Dir(路径 & "*.xls")
  7.     Do While 外薄 <> ""
  8.         If 外薄 <> 本薄 Then
  9.             Set 打开的外薄 = Workbooks.Open(路径 & 外薄)
  10.             外首表数组 = 打开的外薄.Sheets(1).[A1].CurrentRegion
  11.             For 列 = 1 To UBound(外首表数组, 2)
  12.                 If Not 字典.Exists(外首表数组(1, 列)) Then
  13.                     字典列 = 字典列 + 1
  14.                     字典(外首表数组(1, 列)) = 字典列
  15.                 End If
  16.             Next 列
  17.             K = 字典.KEYS
  18.             For 行 = 2 To UBound(外首表数组)
  19.                 字典行 = 字典行 + 1
  20.                 For 列 = 1 To UBound(外首表数组, 2)
  21.                     结果数组(字典行, 字典(外首表数组(1, 列))) = 外首表数组(行, 列)
  22.                 Next 列
  23.             Next 行
  24.             打开的外薄.Close
  25.         End If
  26.         外薄 = Dir
  27.     Loop
  28.     [A1].Resize(1, 字典列) = 字典.KEYS
  29.     Dim 棋盘(1 To 65536, 1 To 5)
  30.     For 行 = 1 To UBound(结果数组)
  31.         分类列 = 结果数组(行, 1) & 结果数组(行, 2)
  32.         If 字典.Exists(分类列) Then
  33.             行数 = 字典(分类列)
  34.             棋盘(行数, 4) = 棋盘(行数, 4) + 结果数组(行, 4)
  35.             棋盘(行数, 5) = 棋盘(行数, 5) + 结果数组(行, 5)
  36.         Else
  37.             计数器 = 计数器 + 1
  38.             字典(分类列) = 计数器
  39.             棋盘(计数器, 1) = 结果数组(行, 1)
  40.             棋盘(计数器, 2) = 结果数组(行, 2)
  41.             棋盘(计数器, 3) = 结果数组(行, 3)
  42.             棋盘(计数器, 4) = 结果数组(行, 4)
  43.             棋盘(计数器, 5) = 结果数组(行, 5)
  44.         End If
  45.     Next 行
  46.     Range("A2").Resize(计数器 - 1, 5) = 棋盘
  47. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2019-1-11 11:30 | 显示全部楼层
楼主代码照抄错了  
Set d = CreateObject("Scripting. Dictionary") 中 ,括号里面的.后面没有空格

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 11:33 | 显示全部楼层
abc123281 发表于 2019-1-11 11:30
楼主代码照抄错了  
Set d = CreateObject("Scripting. Dictionary") 中 ,括号里面的.后面没有空格

谢谢,我知道了

TA的精华主题

TA的得分主题

发表于 2019-1-11 11:53 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2019-1-21 19:25 , Processed in 0.096473 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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