对多个Excel工作簿进行脚本修改

Question

我正在尝试对超过20个Excel工作簿进行大规模的修改。每个工作簿里大约有16个不同的工作表，我想写一个脚本，能够循环遍历每个工作簿和里面的工作表，修改我需要的单元格。我需要保留所有的字符串验证、宏和格式设置。所有的工作簿都是2007格式的。

我已经查看过Python的Excel库和PHPexcel，但在新工作簿写入时，宏、按钮、公式、字符串验证和格式设置都没有保留。有没有简单的方法可以做到这一点，还是说我必须逐个打开每个工作簿来进行修改？我想避免在VBscript中创建宏，并且不想逐个打开每个工作簿来进行我需要的更改。

Answer 1

你还可以使用PyWin32库，通过Python来编写脚本，采用常见的COM技术。这意味着你可以用Python来处理数据，同时还能保存每个工作簿中那些其他Python Excel库可能处理不了的额外部分。

Answer 2

当我需要遍历文件时，我会使用一些来自ozgrid论坛的代码，这段代码利用了Dir命令，可以避免版本问题，同时还能使用通配符来过滤文件名。

Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant
    Dim sTemp As String, sHldr As String
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\" 'append backslash if not already supplied
    sTemp = Dir(fldr & fltr)
    If sTemp = "" Then
        FileList = False
        Exit Function
    End If
    Do
        sHldr = Dir
        If sHldr = "" Then Exit Do
        sTemp = sTemp & "|" & sHldr 'ensures an array is returned
     Loop
    FileList = Split(sTemp, "|")
End Function

还有我自己写的一些代码来配合使用：

Sub MySub()
    Dim vList As Variant
    Dim myWB As Workbook
    Dim targetDir As String
    targetDir = "C:\path\to\folder\"
    If Right$(targetDir, 1) <> "\" Then targetDir = targetDir & "\"
    vList = FileList(targetDir, "*.xl*")  'all file extensions starting with xl (xls, xlsx, xlsm, xla, xlsb, etc.)
    For n = LBound(vList) To UBound(vList)
        Set myWB = Workbooks.Open(targetDir & vList(n))
            'your code for each workbook here
        myWB.Close
    Next n
End Sub

Answer 3

我尽量避免处理多个工作簿，因为这真的很麻烦。如果你经常需要这样做，我建议你回头看看你的工作簿设计，看看能不能把它们合并成一个工作簿。我常常看到一些工作簿是按月保存的，其实应该是一个工作簿里有一张表格存放原始数据，每一行代表一个月，然后再有另一张表格用来展示用户选择的原始数据。这只是一个很大的概括，实际上你的情况可能完全不同。

如果这只是一次性的需求——我知道这不是你想要的解决方案，但我觉得你最好用VBA来循环处理这些工作簿。可以试试下面的代码（未经测试）：

Excel 2003:

Sub AdjustMultipleFiles()
Dim lCount As Long
Dim wbLoopBook As Workbook
Dim wsLoopSheet As Worksheet

With Application
    .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
End With

With Application.FileSearch
        .NewSearch
        '// Change path to suit
        .LookIn = "C:\MyDocuments"
        '// ALL Excel files
        .FileType = msoFileTypeExcelWorkbooks
        '// Uncomment if file naming convention needed
        '.Filename = "Book*.xls"

            '// Check for workbooks
            If .Execute > 0 Then
                '// Loop through all.
                For lCount = 1 To .FoundFiles.Count
                    '// Open Workbook x and Set a Workbook variable to it
                    Set wbLoopBook = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                        '// Loop through all worksheets
                        For Each wsLoopSheet In wbLoopBook.Worksheets
                            '//Update your worksheets here...



                        Next wsLoopSheet
                    '// Close Workbook & Save
                    wbLoopBook.Close SaveChanges:=True
                    '// Release object variable
                    Set wbLoopBook = Nothing
            Next lCount
        End If

End With

With Application
    .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True
End With

End Sub

Excel 2007及以上版本：

Sub AdjustMultipleFiles()
    Dim sFileName As String
    Dim wbLoopBook As Workbook
    Dim wsLoopSheet As Worksheet

    With Application
        .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
    End With

    '// Change path to suit
    ChDir "C:\Documents"

    '// ALL Excel 2007 files
    sFileName = Dir("*.xlsx")

    Do While sFileName <> ""
        '// Open Workbook x and Set a Workbook variable to it
        Set wbLoopBook = Workbooks.Open(Filename:=sFileName, UpdateLinks:=0)
        '// Loop through all worksheets
        For Each wsLoopSheet In wbLoopBook.Worksheets
        '//Update your worksheets here...


        Next wsLoopSheet
        '// Close Workbook & Save
        wbLoopBook.Close SaveChanges:=True
        '// Release object variable
        Set wbLoopBook = Nothing
        '//Next File
        sFileName = Dir
        '//End Loop
    Loop

    With Application
        .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True
    End With

End Sub

Excel 2007及以上版本（使用FileSystemObject - 延迟绑定）

Sub AdjustMultipleFiles()
    Dim wbLoopBook As Workbook
    Dim wsLoopSheet As Worksheet

    With Application
       .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False
    End With

    With CreateObject("Scripting.FileSystemObject")
        '// Change path to suit
        For Each File In .GetFolder("C:\Documents").Files
            '// ALL Excel 2007 files
            If .GetExtensionName(File) = "xlsx" Then
                '// Open Workbook x and Set a Workbook variable to it
                Set wbLoopBook = Workbooks.Open(Filename:=File.Path, UpdateLinks:=0)
                '// Loop through all worksheets
                For Each wsLoopSheet In wbLoopBook.Worksheets
                    '//Update your worksheets here...
                Next wsLoopSheet
                '// Close Workbook & Save
                wbLoopBook.Close SaveChanges:=True
                '// Release object variable
                Set wbLoopBook = Nothing
            End If
        Next File
    End With


    With Application
        .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True
    End With
End Sub