ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] VBA如何批量提取不同工作簿下特定名称工作表的单元格内容

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-20 16:36 | 显示全部楼层 |阅读模式
求帮忙看看怎么解决:想用下面的代码把不同工作簿(销售日报)批量打开,提取其中特定工作表里面产品A的销售额,但问题是,特定工作表的名称不规范,有的工作簿下面叫“营业日报”,有的叫“日报”或者“sheet1”,而且销售额的字段也有两种:销售(收款)和销售(已收款)。
按这段代码的话,黄色部分会报错,“下标越界”,因为有的工作簿下面并没有叫营业日报,日报或者sheet1的工作表,对象不存在,这应该怎么写呢?
奇怪的是,如果只统计叫“营业日报”的,绿色部分并不报错,而且两种名称的销售额都能提取,按理有一样的问题啊,就是对象不存在,会报“下标越界”才对吧?

Sub 日报统计()
    Set fso = CreateObject("scripting.filesystemobject")
    a = 1
    Set sh = ActiveSheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    ThisWorkbook.UpdateLinks = xlUpdateLinksAlways
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If f.Name <> ThisWorkbook.Name Then
            sh.Cells(a, 1) = Split(f.Name, ".")(0)
            Set wb = Workbooks.Open(f)
            Set sheetname1 = wb.Sheets("营业日报")
            Set sheetname2 = wb.Sheets("日报")
            Set sheetname3 = wb.Sheets("sheet1")
            If Not sheetname1 Is Nothing Then
                sheetname = sheetname1
                Else
                    If Not sheetname2 Is Nothing Then
                    sheetname = sheetname2
                Else
                    sheetname = sheetname3
                    End If
            End If
            With sheetname
                Set Rng = .UsedRange.Find("产品A", lookat:=xlWhole)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    Set Rst1 = .UsedRange.Find("销售" & Chr(10) & "(收款)", lookat:=xlWhole)
                    Set Rst2 = .UsedRange.Find("销售" & Chr(10) & "(已收款)", lookat:=xlWhole)
                    If Rst1 Is Nothing Then
                        c = Rst2.Column
                    Else
                        c = Rst1.Column
                    End If
                    sh.Cells(a, 2) = .Cells(r, c)
                End If
            End With
            wb.Close False
            a = a + 1
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub



感谢感谢~

TA的精华主题

TA的得分主题

发表于 2018-8-20 21:30 | 显示全部楼层
新同学你好
    1 想要实现汇总  首先必须让工作表的名称统一   这需要人工来修改
    2  需上传附件

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-21 10:19 | 显示全部楼层
abc123281 发表于 2018-8-20 21:30
新同学你好
    1 想要实现汇总  首先必须让工作表的名称统一   这需要人工来修改
    2  需上传附件

谢谢~
必须让工作表名称统一吗?我就是想看有没有不统一的情况下汇总的办法,应该是有的吧

TA的精华主题

TA的得分主题

发表于 2018-8-21 13:04 来自手机 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Marcxu 发表于 2018-8-21 10:19
谢谢~
必须让工作表名称统一吗?我就是想看有没有不统一的情况下汇总的办法,应该是有的吧

上附件吧,最好是真实的表名
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-12 13:10 , Processed in 0.023199 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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