ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 363|回复: 32

[求助] 求助指导取表格里的数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-9-5 22:42 | 显示全部楼层 |阅读模式
在不打开数据源里的表格(数据源表格有N张表;因表格太大只传了一张);在汇总表里取数据源文件夹下表的数据;求请教;拜托各位大神;我只会等号连接表格;因表格数据多而大导致汇总表打开需要半天

一、汇总表里P1工作簿:1、在不打开数据源文件夹的情况下,用VBA去取数据源文件夹下表格的数据
2、AB4:AB14的数据:取表1的1月份里HK15到HT15(HK15:HT15)行的数据
3、AC4:AC14的数据:取表1的2月份里HK15到HT15(HK15:HT15)行的数据
4、以此类推


二、汇总表里P2工作簿:
1、在不打开数据源文件夹的情况下,用VBA去取数据源文件夹下表格的数据
2、AC列从AC6行到AC250行的数据:在文件夹下表1里的1月份中取HK15到HK259(HK15:Hk259)行的数据
3、AD列从Ad6行到Ad250行的数据:在文件夹下表1里的2月份中取HK15到HK259(HK15:Hk259)行的数据
4、以此类推




三、汇总表里P3工作簿:
1、在不打开数据源文件夹的情况下,用VBA去取数据源文件夹下表格的数据
2、AC列从AC6行到AC250行的数据:在文件夹下表1里的1月份中取G15到G259(G15:G259)行的数据
3、AD列从Ad6行到Ad250行的数据:在文件夹下表1里的2月份中取G15到G259(G15:G259)行的数据
4、以此类推



四、汇总表里P4工作簿:
1、在不打开数据源文件夹的情况下,用VBA去取数据源文件夹下表格的数据
2、AC列从AC6行到AC250行的数据:在文件夹下表1里的1月份中取C15到C259(C15:C259)行的数据
3、AD列从Ad6行到Ad250行的数据:在文件夹下表1里的2月份中取C15到C259(C15:C259)行的数据
4、以此类推



五、汇总表里P5工作簿:

1、在不打开数据源文件夹的情况下,用VBA去取数据源文件夹下表格的数据(转置数据)
2、模块2中L212:IV212单元格开始的数据:取文件夹里表1的1月C15:C259的数据
3、模块2中L213:IV213单元格开始的数据:取文件夹里表1的1月D15:D259的数据
4、以此类推…
5、模块2中L420:IV420单元格开始的数据:取文件夹里表1的2月C15:C259的数据
6、模块2中L421:IV421单元格开始的数据:取文件夹里表1的2月D15:D259的数据
7、以此类推…

数据模块.rar

1.19 MB, 下载次数: 13

TA的精华主题

TA的得分主题

发表于 2019-9-6 07:58 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-9-6 08:33 | 显示全部楼层
看你这描述,难度不大,就是需要费些时间,,
  
有空再说吧,,

TA的精华主题

TA的得分主题

发表于 2019-9-6 13:42 | 显示全部楼层
Sub 取数()
Dim wd As Workbook, ws As Worksheet
Dim cnn, sql$
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set ws = ActiveSheet
Set wd = ThisWorkbook
'------------------------
    mydir = Dir(ThisWorkbook.Path & "\数据源\" & "*.xlsx")
    Do While mydir <> ""
        If mydir = "表1.xlsx" Then
           cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\数据源\" & mydir
           sql = "select * from[1月$g15:g250]"
           Set rs = cnn.Execute(sql)
           ws.Range("ac6").CopyFromRecordset rs
        End If
    mydir = Dir
    Loop
End Sub
这是在p3表取1月工作表g15:g250的数据

评分

参与人数 1鲜花 +2 收起 理由
kulagen + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 14:45 | 显示全部楼层
本帖最后由 kulagen 于 2019-9-6 15:25 编辑
donghui2363 发表于 2019-9-6 13:42
Sub 取数()
Dim wd As Workbook, ws As Worksheet
Dim cnn, sql$

谢谢 能取;但是我取的是1-12月的数据;我自己按你复制黏贴 ;能不能优化???;好像也不对

Sub 取数P3()
Dim wd As Workbook, ws As Worksheet
Dim cnn, aa, ab, ac, ad, ae, af, ag, ah, ai, aj, ak, al$
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set ws = ActiveSheet
Set wd = ThisWorkbook
'------------------------
    mydir = Dir(ThisWorkbook.Path & "\数据源\" & "*.xlsx")
    Do While mydir <> ""
        If mydir = "表1.xlsx" Then
           cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\数据源\" & mydir
           aa = "select * from[1月$g15:g250]"
           Set rs = cnn.Execute(aa)
           ws.Range("ac6").CopyFromRecordset rs
           
           ab = "select * from[2月$g15:g250]"
           Set rs = cnn.Execute(ab)
           ws.Range("ad6").CopyFromRecordset rs
           
            ac = "select * from[3月$g15:g250]"
           Set rs = cnn.Execute(ac)
           ws.Range("ae6").CopyFromRecordset rs
           
            ad = "select * from[4月$g15:g250]"
           Set rs = cnn.Execute(ad)
           ws.Range("af6").CopyFromRecordset rs
           
            ae = "select * from[5月$g15:g250]"
           Set rs = cnn.Execute(ae)
           ws.Range("ag6").CopyFromRecordset rs
           
            af = "select * from[6月$g15:g250]"
           Set rs = cnn.Execute(af)
           ws.Range("ah6").CopyFromRecordset rs
           
            ag = "select * from[7月$g15:g250]"
           Set rs = cnn.Execute(ag)
           ws.Range("ai6").CopyFromRecordset rs
           
            ah = "select * from[8月$g15:g250]"
           Set rs = cnn.Execute(ah)
           ws.Range("ad6").CopyFromRecordset rs
           
            ai = "select * from[9月$g15:g250]"
           Set rs = cnn.Execute(ai)
           ws.Range("aj6").CopyFromRecordset rs
           
               aj = "select * from[10月$g15:g250]"
           Set rs = cnn.Execute(aj)
           ws.Range("ak6").CopyFromRecordset rs
           
               ak = "select * from[11月$g15:g250]"
           Set rs = cnn.Execute(ak)
           ws.Range("al6").CopyFromRecordset rs
           
               al = "select * from[12月$g15:g250]"
           Set rs = cnn.Execute(al)
           ws.Range("am6").CopyFromRecordset rs
           
        End If
    mydir = Dir
    Loop
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 14:45 | 显示全部楼层
opel-wong 发表于 2019-9-6 08:33
看你这描述,难度不大,就是需要费些时间,,
  
有空再说吧,,

谢谢 抽空帮忙看看

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 14:46 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-9-6 15:21 | 显示全部楼层
Sub 取数()
Dim wd As Workbook, ws As Worksheet
Dim cnn, sql$
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set ws = ActiveSheet
Set wd = ThisWorkbook
'------------------------
    mydir = Dir(ThisWorkbook.Path & "\数据源\" & "*.xlsx")
    Do While mydir <> ""
        If mydir = "表1.xlsx" Then
           cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\数据源\" & mydir
           For i = 1 To 12
            x = i & "月"
            sql = "select * from [" & x & "$g15:g259]"
            Set rs = cnn.Execute(sql)
            ws.Range("ab6").Offset(0, i).CopyFromRecordset rs
           Next i
        End If
    mydir = Dir
    Loop
End Sub
p3表取12个月的

评分

参与人数 1鲜花 +1 收起 理由
kulagen + 1 值得肯定

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 15:27 | 显示全部楼层
donghui2363 发表于 2019-9-6 15:21
Sub 取数()
Dim wd As Workbook, ws As Worksheet
Dim cnn, sql$

谢谢 ;逻辑对上了

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-9-6 15:28 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

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

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

GMT+8, 2019-12-12 14:10 , Processed in 0.378352 second(s), 17 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

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

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

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