如何把一个工作簿中的值填到多个工作簿的工作表中

fridayke · 发表于 2011-11-2 20:29

请教高手.如何将总表中各城市的相关指标数据分别填到表1和表2中? 因为每月有大量的数据需要手工复制粘贴,着实痛苦~

说明1:总表后带有时间后缀,譬如后缀为2011年10月,则将该表中相关值填入表1或表2中对应的2011年10月一列;2:各城市分散在表1和表2中,且表1或表2中的sheet名并不和总表出现的地名精确匹配,譬如总表为上海,表1的sheet名为上海地区;3:表1或表2中2011年10月的数据格式与2011年9月保持一致.

DTT.rar (20.07 KB, 下载次数: 26)

zhaogang1960 · 发表于 2011-11-2 23:20

本帖最后由 zhaogang1960 于 2011-11-2 23:21 编辑

请测试
Sub 宏1()
Dim arr, d As Object, MyDate As Date, c As Range, i&
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet
Set sht = ActiveSheet
Set d = CreateObject("scripting.dictionary")
arr = Range("a2", Cells(2, Columns.Count).End(1))
For i = 2 To UBound(arr, 2)
      d(Trim(arr(1, i)) & "地区") = i
Next
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xlsx")
MyDate = Replace(Mid(ThisWorkbook.Name, 3), ".xlsm", "1日")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While MyName <> ""
      If MyName <> ThisWorkbook.Name Then
         With Workbooks.Open(MyPath & MyName)
            For Each sh In .Sheets
                  If d.Exists(sh.Name) Then
                     Set c = sh.Rows(2).Find(MyDate, , xlFormulas, xlWhole)
                     If Not c Is Nothing Then c.Offset(1).Resize(5).Value = sht.Cells(3, d(sh.Name)).Resize(5).Value
                  End If
            Next
            .Close True
         End With
      End If
      MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "完毕"
End Sub

zhaogang1960 · 发表于 2011-11-2 23:22

请看附件

DTT.rar (33.09 KB, 下载次数: 54)

fridayke · 发表于 2011-11-3 20:05

哇,好厉害啊,谢谢老师,我今天研究了一天,还没完全弄明白,继续研究中...

gwxqqq · 发表于 2011-11-3 20:27

高手就是高手啊
真厉害

fridayke · 发表于 2011-11-3 20:24

请教一下: MyDate = Replace(Mid(ThisWorkbook.Name, 3), ".xlsm", "1日")
REPLACE的函数是替换作用,在这里是截取总表第三位以后的字符,然后?".xlsm","1日"的用途是什么啊?

zhaogang1960 · 发表于 2011-11-3 20:53

fridayke 发表于 2011-11-3 20:24
请教一下: MyDate = Replace(Mid(ThisWorkbook.Name, 3), ".xlsm", "1日")
REPLACE的函数是替换作用,在这 ...

"总表2011年10月.xlsm"取第三个后面的字符串："2011年10月.xlsm"
"2011年10月.xlsm"中的".xlsm"换成"1日"得到"2011年10月1日"
把"2011年10月1日"赋值给一个日期变量MyDate，就变成了2011-10-1

zhaogang1960 · 发表于 2012-5-9 15:42

yah760911 发表于 2012-5-9 13:53
在线等待!!!

模拟效果，说明要求

yah760911 · 发表于 2012-5-9 17:21

版主,如何把每个工作表里的最后两行删除啊,更新后不要留在更新后的工作表里

zhaogang1960 · 发表于 2012-5-9 17:27

yah760911 发表于 2012-5-9 17:21
版主,如何把每个工作表里的最后两行删除啊,更新后不要留在更新后的工作表里

那是上个程序留下来的，与这次代码无关，请看附件

测试.rar (25.96 KB, 下载次数: 18)

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

[求助] 如何把一个工作簿中的值填到多个工作簿的工作表中

评分