ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

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

[求助] 一个文件夹下有多个文件,VBA汇总生成一个汇总表

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-9 16:52 | 显示全部楼层 |阅读模式
A列相同,C列数据相加

员工购买.zip

49.67 KB, 下载次数: 18

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-9 16:53 | 显示全部楼层
在线等,有点急,版主大大速来

TA的精华主题

TA的得分主题

发表于 2018-8-9 17:14 | 显示全部楼层
hjq018 发表于 2018-8-9 16:53
在线等,有点急,版主大大速来

Sub test()
    Set d = CreateObject("Scripting.Dictionary")
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Application.ScreenUpdating = False
    ReDim brr(1 To 10000, 1 To 3)
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set sht = GetObject(p & f).Sheets("Sheet1")
            Arr = sht.UsedRange
            Workbooks(f).Close False
            For i = 1 To UBound(Arr)
                If Not d.exists(Arr(i, 1)) Then
                    m = m + 1: d(Arr(i, 1)) = m
                    For j = 1 To UBound(Arr, 2)
                        brr(m, j) = Arr(i, j)
                    Next
                Else
                    brr(d(Arr(i, 1)), 3) = brr(d(Arr(i, 1)), 3) + Arr(i, 3)
                End If
            Next
        End If
        f = Dir
    Loop
    Set sht = Nothing
    [a1].Resize(m, UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
    MsgBox "汇总完成!"
End Sub

TA的精华主题

TA的得分主题

发表于 2018-8-9 17:15 | 显示全部楼层
hjq018 发表于 2018-8-9 16:53
在线等,有点急,版主大大速来

代码需要审核,先测试附件:

员工购买.rar

58.29 KB, 下载次数: 31

评分

参与人数 1鲜花 +2 收起 理由
LMY123 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-8-9 17:25 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-8-9 18:53 | 显示全部楼层
……………………………………

工作簿1.rar

13.71 KB, 下载次数: 24

评分

参与人数 2鲜花 +5 收起 理由
LMY123 + 3 优秀作品
jjmysjg + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-8-9 22:04 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-5 14:55 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

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

GMT+8, 2018-12-19 15:11 , Processed in 0.115238 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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