Excel VBA:批量导出多个文件中某些单元格的内容

2010-11-25  籽藤 

  上一篇博文“Excel VBA常用语句集锦”罗列了很多VBA脚本,但是比较零碎,还不过瘾。干脆把我这两天写的脚本贴出来好了。首先,说说这个写脚本的用意。以下是某张审计表的截图,QA需要根据“符合项”和“不符合项”来提供项目质量的周报和月报。


  亲爱的你有没有注意到:一张审计表中有N个Sheet页,每个Sheet页都有不同的符合项和不符合项。一个项目下来,审计表往往有几十张;要一个个地打开文件,一个个Sheet核对,这是很费力的事情。So,如果能将多个文件中“符合项”“不符合项”的内容 批量导出到一张Excel中,是多么Happy的一件事情啊:)

-------------华丽的分割线:VBA脚本--------------------

Sub AutoOpen()
'
' Macro1open Macro
'
'
Dim filelist, b As String
Dim f() As String


    MyExcelFileName = Dir("E:\temp\审计表\*.xls") '要修改路径

    Do While Len(MyExcelFileName) > 0

        If (Len(filelist) <> 0) Then
    filelist = filelist + "," + MyExcelFileName
        Else
    filelist = filelist + MyExcelFileName
        End If

    MyExcelFileName = Dir

    Loop

'此处输入文件名列表,用英文逗号分隔
f = Split(filelist, ",")

For Each file In f()
    Workbooks.Open Filename:="E:\temp\审计表\" & file '要修改路径

        Set Wb = ActiveWorkbook '打开它
'

ThisWorkbook.Sheets(1).Cells(num + 1, 1) = file '第一列放工作簿的名称

     For i = 2 To Worksheets.Count
        ThisWorkbook.Sheets(1).Cells(num + i, 2) = Worksheets(i).Name '各个sheet的名称

        '获得符合项和不符合项数
        With Worksheets(i).Range("B6:B100")

        Set c = .Find("符合项数", LookIn:=xlValues)
        Set d = .Find("不符合项数", LookIn:=xlValues)

        ThisWorkbook.Sheets(1).Cells(num + i, 3) = c.Offset(0, 1) 'Offset方法的第一个参数是行偏移,第二个参数是列偏移

        ThisWorkbook.Sheets(1).Cells(num + i, 4) = d.End(xlToRight).Text

        End With

     Next i

       num = num + Wb.Sheets.Count
       On Error Resume Next
                 Wb.Close False ' 不保存就关闭这个打开的工作簿

         Next

     Application.ScreenUpdating = True
     Application.DisplayAlerts = True

End Sub

------------------------End----------------------------------

运行之后的效果如图:



Wow, 帅气~VBA真的很强大  


 

 

 

533°/5336 人阅读/0 条评论 发表评论

登录 后发表评论