提取指定工作簿下多个文件指定单元格的数据

dagal

求大侠帮忙，在“1807-JZ07班结表”的辅助表中实现弹出窗口选择文件，然后在“1807-JZ07客房营业日报表”中将1-31张表的b4,b6,b9,b14,b17横项提取到“1807-JZ07班结表”辅助表的a7-a11列，但数据是横着一排过去。谢谢啦~

JZ07.rar (61.29 KB, 下载次数: 43)

2018-7-25 09:53 上传

点击文件名下载附件

这个是昵称吗

我猜应该可以的！对可以的

dagal

附件已上传了，在线求助，谢谢~~~

dagal

前几天一直上传不了附件，今天可以了，求助大神帮忙~~~

opiona

http://club.excelhome.net/thread-1409141-1-1.html

dagal

有哪位大神有空帮忙看看，在此谢过~~

LMY123

同薄多表不连续单元格合并成一薄一表

魂断蓝桥

Sub a()
Dim f
f = Application.GetOpenFilename("EXCEL Files (*.xls), *.xls")
If f = False Then Exit Sub
Dim cnn As Object
Dim Sql As String, i%, arr, rs
Set cnn = CreateObject("ADODB.CONNECTION")
Set rs = CreateObject("adodb.Recordset")
cnn.Open "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties='Excel 8.0;HDR=YES'; Data Source=" & f
For i = 1 To 31
    Sql = Sql & "select 日营业额+0 from [" & i & "$a3:b17] where 项目='1房租' or 项目='C会务服务费' or 项目='6客房酒水收入' or 项目='D赔偿费' or 项目='P横幅' UNION ALL "
Next
Sql = Left(Sql, Len(Sql) - 11)
rs.Open Sql, cnn, 1, 1
[b4:af11] = ""
For i = 1 To 31
    [a7].Offset(0, i).CopyFromRecordset rs, 5
Next
cnn.Close: Set cnn = Nothing

dagal

魂断蓝桥 发表于 2018-7-25 14:47
Sub a()
Dim f
f = Application.GetOpenFilename("EXCEL Files (*.xls), *.xls")

谢谢，最后少了一句end sub

dagal

魂断蓝桥 发表于 2018-7-25 14:47
Sub a()
Dim f
f = Application.GetOpenFilename("EXCEL Files (*.xls), *.xls")

大神，这个在03版下可以吗？我没测试过。。。