AppleScript 将多个 Excel 文件合并到一个工作表中 [英] AppleScript to combine multiple Excel files into a single worksheet

问题描述

我不是 AppleScript 的专家，所以我一直试图找到一个 AppleScript 代码的例子，它可以成功地处理一批 Excel 文件(每个文件都有一个工作表)，将每个文件的内容复制到一个单一目标工作表.

I am not an expert in AppleScript, so I've ben trying to find an example of AppleScript code that can successfully process a batch of Excel files (each one with a single worksheet), copying the content of each one into a single destination sheet.

这是我想到的伪代码:

pick source folder with Excel files;
pick destination Excel file;

for each file within the source folder:
        copy data from default sheet;
        paste data into destination sheet's first unused row
end

这是我想出的代码.它确实正确打开了每个文件，但没有发生复制/过去操作.知道如何让它工作吗?

This is the code I came up with. It does open correctly each file, but the copy/past operation is just not happening. Any idea how to get it to work?

set main_folder to choose folder with prompt "Please select the folder containing the Excel files:"

set target_excel to choose file with prompt "Please select target Excel file:"

set excel_extension_list to {"xls", "xlsx", "csv"}

tell application "Finder"
    set excel_files to (files of main_folder whose name extension is in excel_extension_list) as alias list
end tell

tell application "Microsoft Excel"
    open target_excel

    repeat with a_file in excel_files
        open a_file
        activate a_file
        tell sheet 1 of workbook a_file
            set the_range to value of used range
            set number_of_source_rows to count of rows of the_range
        end tell

        activate target_excel
        tell sheet 1 of workbook target_excel
            set new_range to value of used range
            set number_of_destination_rows to count of rows of new_range
            set destination_range to range "A" & (number_of_destination_rows + 1) & ":E" & (number_of_destination_rows + 1 + number_of_source_rows)
            set value of destination_range to the_range
            close workbook a_file saving no
        end tell
    end repeat
end tell

推荐答案

在 Excel 2011 中尝试和测试

我的假设

1. 目标文件有一个名为 Sheet1
的工作表
2. 我正在从所有文件的第一张工作表中检索信息.根据情况进行更改.

代码

我已经对代码进行了注释，因此您理解它应该不会有任何问题.:)

I have commented the code so you should not have any problem understanding it. :)

Sub Sample()
    Dim wbI As Workbook, wbO As Workbook
    Dim lRowO As Long
    Dim lRowI As Long, lColI As Long
    Dim DestFile As Variant
    Dim RootFldr As String, FilesFolder As String, strFile As String

    '~~> Get the Root Folder
    RootFldr = MacScript("return (path to desktop folder) as String")

    '~~> Show the Folder Browser to select the folder which has the files
    FilesFolder = MacScript("(choose folder with prompt ""Please select the folder which has excel files""" & _
    "default location alias """ & RootFldr & """) as string")

    '~~> If user doesn't select anything then exit
    If FilesFolder = "" Then Exit Sub

    '~~> Show the File Select dialog for the output file
    DestFile = Application.GetOpenFilename("XLS8,XLS4")

    '~~> Open output file
    Set wbO = Workbooks.Open(DestFile)

    '~~> Get the next available row for writing
    lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _
            After:=wbO.Sheets("Sheet1").Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas).Row + 1

    '~~> Loop through each file in the folder
    strFile = Dir(FilesFolder)

    Do While Len(strFile) > 0
        '~~> Check for the file if it is csv,xls or xlsx
        If Right(strFile, 3) = "csv" Or _
        Right(strFile, 3) = "xls" Or _
        Right(strFile, 4) = "xlsx" Then
            '~~> Open the file from the folder
            Set wbI = Workbooks.Open(FilesFolder & strFile)

            With wbI
                '~~> Get the last row in the file from sheet #1
                lRowI = .Sheets(1).Cells.Find(What:="*", _
                        After:=.Sheets(1).Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row

                '~~> Get the last column in the file from sheet #1
                lColI = .Sheets(1).Cells.Find(What:="*", _
                        After:=.Sheets(1).Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column

                With .Sheets(1)
                    '~~> Copy the selected range
                    .Range(.Cells(1, 1), .Cells(lRowI, lColI)).Copy

                    '~~> Paste in destination file
                    wbO.Sheets("Sheet1").Range("A" & lRowO).PasteSpecial xlValues

                    '~~> Get the next available row for writing
                    lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _
                            After:=wbO.Sheets("Sheet1").Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row + 1
                End With
            End With
            '~~> Close the file after copying from it
            wbI.Close SaveChanges:=False
        End If
        strFile = Dir
    Loop

    MsgBox "Done"
End Sub

这篇关于AppleScript 将多个 Excel 文件合并到一个工作表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！