提取店名，并根据店名求和

chenbenhai · 发表于 2019-1-11 08:45

本帖最后由 chenbenhai 于 2019-1-11 09:19 编辑

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

cjc209 · 发表于 2019-1-11 09:51

不管类型吗你的每个表的字段名不一样吗？

cjc209 · 发表于 2019-1-11 09:54

如果表给完全一样就好整的多就是一个字典加遍历所有文件就完事没有难度如果每个表的字段不同就要复杂些

chenbenhai · 发表于 2019-1-11 10:06

汇总表里只要店铺名称代码数量金额四个字段 1月表里的类型不提取

蓝桥玄霜 · 发表于 2019-1-11 10:31

请见代码。

chenbenhai · 发表于 2019-1-11 11:11

本帖最后由 chenbenhai 于 2019-1-11 11:34 编辑

蓝桥玄霜发表于 2019-1-11 10:31
请见代码。

多谢版主，谢谢

LMY123 · 发表于 2019-1-11 11:26

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

Sub 同夹_多薄_首表_AB分类_BC汇总_字典法参考()
Dim 结果数组(1 To 65536, 1 To 256)
Set 字典 = CreateObject("scripting.dictionary")
路径 = ThisWorkbook.Path & ""
本薄 = ThisWorkbook.Name
外薄 = Dir(路径 & "*.xls")
Do While 外薄 <> ""
If 外薄 <> 本薄 Then
Set 打开的外薄 = Workbooks.Open(路径 & 外薄)
外首表数组 = 打开的外薄.Sheets(1).[A1].CurrentRegion
For 列 = 1 To UBound(外首表数组, 2)
If Not 字典.Exists(外首表数组(1, 列)) Then
字典列 = 字典列 + 1
字典(外首表数组(1, 列)) = 字典列
End If
Next 列
K = 字典.KEYS
For 行 = 2 To UBound(外首表数组)
字典行 = 字典行 + 1
For 列 = 1 To UBound(外首表数组, 2)
结果数组(字典行, 字典(外首表数组(1, 列))) = 外首表数组(行, 列)
Next 列
Next 行
打开的外薄.Close
End If
外薄 = Dir
Loop
[A1].Resize(1, 字典列) = 字典.KEYS
Dim 棋盘(1 To 65536, 1 To 5)
For 行 = 1 To UBound(结果数组)
分类列 = 结果数组(行, 1) & 结果数组(行, 2)
If 字典.Exists(分类列) Then
行数 = 字典(分类列)
棋盘(行数, 4) = 棋盘(行数, 4) + 结果数组(行, 4)
棋盘(行数, 5) = 棋盘(行数, 5) + 结果数组(行, 5)
Else
计数器 = 计数器 + 1
字典(分类列) = 计数器
棋盘(计数器, 1) = 结果数组(行, 1)
棋盘(计数器, 2) = 结果数组(行, 2)
棋盘(计数器, 3) = 结果数组(行, 3)
棋盘(计数器, 4) = 结果数组(行, 4)
棋盘(计数器, 5) = 结果数组(行, 5)
End If
Next 行
Range("A2").Resize(计数器 - 1, 5) = 棋盘
End Sub

复制代码

abc123281 · 发表于 2019-1-11 11:30

楼主代码照抄错了
Set d = CreateObject("Scripting. Dictionary") 中，括号里面的.后面没有空格

chenbenhai · 发表于 2019-1-11 11:33

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

谢谢，我知道了

cjc209 · 发表于 2019-1-11 11:53

蓝桥玄霜发表于 2019-1-11 10:31
请见代码。

老师你的只是合并了没有汇总啊

		自动登录	找回密码
密码			免费注册

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

评分

最新热点 /1