[求助]有许多excel工作薄，大概500个，格式都一样

eq800

试试

yIh5uEMy.rar (9.68 KB, 下载次数: 857)

2007-7-26 14:05 上传

点击文件名下载附件
[求助]有许多excel工作薄，大概500个，格式都一样

eq800

QUOTE:

以下是引用cywx在2007-7-24 21:03:44的发言：

能不能再解释一下那段代码中每一个细节?

如果我的多个工作簿不是在同一个文件夹内(假设在一个大文件夹中的很多个小文件夹中)

代码应该如何改呢?

谢谢!

1kFJrtuq.rar (9.68 KB, 下载次数: 808)

2007-7-26 14:07 上传

点击文件名下载附件
[求助]有许多excel工作薄，大概500个，格式都一样

cheng2000hua

eq800

绝对偶像级! 学习了

cywx

谢谢!果然很强.

几百个文件中如果有些文件的内容连接了另外的文件，就会询问"是否更新"

尤其是源不存在了的时候.有没有办法不询问更新?

maillgh

挺实用，多谢!

xxhacker

eq800 强

wywu21

以上的我都看了，但还是没法解决我的问题。

我的情况是这样的，文件夹D:\材料\20070812下面有N个工作薄(N001.xls,N002.xls,......),每个工作薄都有4个sheets,分别为"设置","汇总","区公司材料","地方材料".

现在需要把各个工作薄里面的"汇总"里的a5:m往下的内容(行数不定)汇总。

问题其实和上面讲的是一样的，就是多了一个：指定工作表

另帮我看一下我对代码的理解是否正确：

Sub 按钮1_单击()

   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   myPath = ThisWorkbook.Path & "\分表\"          '把文件路径定义给变量
  
   myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   Do While myFile <> ""                     '当指定路径中有文件时进行循环
      If myFile <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
          For i = 1 To AK.Sheets.Count             '需要统计的工作薄里有多少个表
         aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row  '需要统计的表里有多少行 
         tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1  '汇总表里最后空行是在哪

            'AK.Sheets(i).Select
         AK.Sheets(i).Range("a3:k" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
         Next
         Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
      End If
      myFile = Dir                                   '找寻下一个*.xls文件
   Loop
     
   Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
   MsgBox "汇总完成，请查看！", 64, "提示"

End Sub

qTCztfgA.rar (31.58 KB, 下载次数: 192)

2007-8-14 11:46 上传

点击文件名下载附件

[此贴子已经被作者于2007-8-14 11:46:42编辑过]

eq800

6I77qxyH.rar (35.14 KB, 下载次数: 435)

2007-8-14 13:49 上传

点击文件名下载附件
[求助]有许多excel工作薄，大概500个，格式都一样

wywu21

我需要的正是如何把那些工作薄的“材料(汇总)”单独提取出来。或是把其它sheet删除

wywu21

删除其它工作表已解决，昨天在引用别人的代码时，搞错了。

Sub 按钮1_单击()
Dim app As Excel.Application
Dim xlapp As Variant
Dim xlworkbooks As Workbooks
Dim MyFile, MyPath, MyName
MyPath = "d:\20070812"
MyName = Dir(MyPath & "\" & "*.xls")
Do While MyName <> ""    ' 开始循环。

    Set xlapp = Workbooks.Open(MyPath & "\" & MyName)
    Set w_sheets = xlapp.Worksheets
    xlapp.Application.DisplayAlerts = false  '不显示警告

    'xlapp.Worksheets(2).Delete  我这里弄错了。应该用下面一行的。
    xlapp.Sheets(2).Delete
    Workbooks(MyName).Save
    xlapp.Application.DisplayAlerts = True
    xlapp.Application.Visible = True
    Workbooks(MyName).Close
    MyName = Dir    ' 查找下一个目录。
Loop
End Sub