求跨表格自动提取文件夹表格中对应日期数据

Tromso · 发表于 2016-5-20 01:56

本帖最后由 Tromso 于 2016-5-21 09:33 编辑

先谢谢各位了~~~ 小弟感激不尽~

lzqmsy · 发表于 2016-5-20 05:36

本帖最后由 lzqmsy 于 2016-5-20 05:38 编辑

又上来一个?

Tromso · 发表于 2016-5-20 08:56

lzqmsy 发表于 2016-5-20 05:36
又上来一个?

??? 啥叫又呢？

Tromso · 发表于 2016-5-20 12:01

自己顶一下

lzqmsy · 发表于 2016-5-20 18:44

Tromso 发表于 2016-5-20 08:56
??? 啥叫又呢？

啥叫"又"啊?表示重复或继续相同的,你说是吧?

opiona · 发表于 2016-5-20 19:04

说明一下，数据如何提取的
最好模拟一下提取后的结果！

Tromso · 发表于 2016-5-21 09:33

opiona 发表于 2016-5-20 19:04
说明一下，数据如何提取的
最好模拟一下提取后的结果！

已发大神帮帮忙看看

Tromso · 发表于 2016-5-21 09:34

lzqmsy 发表于 2016-5-20 18:44
啥叫"又"啊?表示重复或继续相同的,你说是吧?

知道了小弟新来不懂多担待

opiona · 发表于 2016-5-21 11:33

Set SH0 = Worksheets("基础数据")
SH0.Range("B2:DZ1048576").ClearContents
FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
For i = 0 To UBound(FileArr)
Set WB = Workbooks.Open(FileArr(i)) '//打开工作簿
Set SHX = WB.Sheets(1)
For IROW = 2 To SH0.Range("A1048576").End(3).Row '//查找日期
Set C = SHX.Range("A:A").Find(Format(SH0.Cells(IROW, 1), "yyyy-MM-dd"), , LOOKAT:=xlWhole) '//基础表：注意日期的格式
' Set C = SHX.Range("A:A").Find(SH0.Cells(IROW, 1), , LOOKAT:=xlWhole) '//或是设置成文本格式
If Not C Is Nothing Then '//如果有此日期
strName = GetPathFromFileName(FileArr(i)) '//工作簿名
Select Case strName
Rem 七种粘贴方式
Case "1" '//工作簿名
RangeA = "B" & IROW '//汇总表粘贴位置
RangeAddress = "B" & C.Row & ":AE" & C.Row '//复制每日取数中的：位置
Case "2"
RangeA = "AF" & IROW
RangeAddress = "B" & C.Row & ":P" & C.Row
Case "3"
RangeA = "AU" & IROW
RangeAddress = "B" & C.Row & ":AE" & C.Row
Case "4"
RangeA = "BY" & IROW
RangeAddress = "B" & C.Row & ":AE" & C.Row
Case "5"
RangeA = "DC" & IROW
RangeAddress = "B" & C.Row & ":D" & C.Row
Case "6"
RangeA = "DF" & IROW
RangeAddress = "B" & C.Row & ":H" & C.Row
Case "7"
RangeA = "DM" & IROW
RangeAddress = "B" & C.Row & ":E" & C.Row
End Select
SHX.Range(RangeAddress).Copy SH0.Range(RangeA) '//复制数据
End If
Next IROW
WB.Close False '//
Next

复制代码

opiona · 发表于 2016-5-21 11:36

123.rar (84.07 KB, 下载次数: 37)

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

[求助] 求跨表格自动提取文件夹表格中对应日期数据