将两个单独的xlsx文件中的.xlsx工作表合并到新工作簿中的单个工作表中
我需要用vbscript(而不是vba)完成这个。 我找不到如何做到这一点的任何例子。 我已经有了vbs,可以完成所有我需要的Excel文件的主要处理,但是我需要的最后一部分只是简单地将两个单独的.xlsx文件中的工作表合并到一个工作表中,放到一个新的工作簿中。
我已经find了使用vba将两个文件合并到单独的wb中的示例,但是我需要它们在同一个工作表上,并通过vbscript。 它基本上就像两张床单的结合。 它们都包含相同数量的列(6列)和相同types的数据。 基本上需要复制任一电子表格中的标题并粘贴到新的工作簿/工作表中,然后将所有数据复制到标题下方的新工作簿/表单中。 希望这是有道理的。 任何帮助表示赞赏。
我半接近这个,这将两个数据表放到同一个新的工作簿称为“合并”,但需要它合并到一个工作表。
Set objExcel = WScript.CreateObject ("Excel.Application") objExcel.Visible = false strFileName = "c:\excel\merged.xlsx" Set objWbA = objExcel.WorkBooks.open("c:\excel\wb1.xlsx") Set objWbB = objExcel.WorkBooks.open("c:\excel\wb2.xlsx") Set objWorkbook = objExcel.Workbooks.Add() objwba.worksheets(1).copy _ objWorkbook.worksheets(1) objwbb.worksheets(1).copy _ objWorkbook.worksheets(2) objWorkbook.SaveAs(strFileName) objWorkbook.close objWbA.Close True objWbB.Close True objExcel.Quit Set objExcel = Nothing
==========================
这是我想出的一个解决scheme(用CSV输出):
Option Explicit Dim objExcel Dim strFilename Dim objWbA Dim objWbB Dim Lastrow Dim Lastrow1 Dim objWorkbook Dim objSheeta Dim objSheetb Set objExcel = WScript.CreateObject ("Excel.Application") objExcel.Visible = false objExcel.displayalerts = false strFileName = "c:\excel\merged.csv" Set objWbA = objExcel.WorkBooks.open("c:\excel\wb1.xlsx") Set objSheeta = objWbA.Sheets("wb1") Set objWbB = objExcel.WorkBooks.open("c:\excel\wb2.xlsx") Set objSheetb = objWbB.Sheets("wb2") Set objWorkbook = objExcel.Workbooks.Add() Const xlUp = -4162 Const xlPasteValues = -4163 Const xlPasteFormats = -4122 Const xlPasteValuesAndNumberFormats = 12 with objSheeta Lastrow = .Cells(objSheeta.Rows.Count, 1).End(xlUp).Row .Range("B1:F" & Lastrow).Copy end with objWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats with objSheetb Lastrow1 = .Cells(objSheetb.Rows.Count, 1).End(xlUp).Offset(1, 0).Row .Range("B2:F" & Lastrow1).Copy end with objWorkbook.Worksheets("Sheet1").Range("A" & Lastrow1).PasteSpecial xlPasteValuesAndNumberFormats '=================================== objExcel.CutCopyMode = False objExcel.ScreenUpdating = True objWorkbook.SaveAs(strFileName), 6 objWorkbook.close True objWbA.Close True objWbB.Close True objExcel.Quit Set objExcel = Nothing
如果执行Worksheet.Copy方法并忽略提供目标,则工作表将被复制到保存ActiveWorkbook属性的新工作簿中。 这可能是开始一个新的工作簿的最佳途径。
Set objExcel = WScript.CreateObject ("Excel.Application") objExcel.Visible = False 'True for testing strFileName = "c:\tmp\merged" '<~~ no file extension, FileType:=51 (xlOpenXMLWorkbook) will do that Set objWbA = objExcel.WorkBooks.open("c:\tmp\wb1.xlsx") Set objWbB = objExcel.WorkBooks.open("c:\tmp\wb2.xlsx") rws = objWbA.Worksheets(1).Rows.Count '<~~ 65536 or 1048576 (need this below) objWbA.Worksheets(1).Copy '<~~ copy to a new workbook with one worksheet objWbB.Worksheets(1).Cells(1, 1).CurrentRegion.Copy _ objExcel.ActiveWorkbook.Worksheets(1).Cells(rws, 1).End(-4162).Offset(1,0) '-4162 is xlUp objExcel.ActiveWorkbook.SaveAs strFileName, 51 '<~~ 51 is FileType:=xlOpenXMLWorkbook objExcel.ActiveWorkbook.Close False '<~~ saved on the line immediately above objWbA.Close False 'don't save if we didn't change anything objWbB.Close False 'don't save if we didn't change anything objExcel.Quit Set objExcel = Nothing
如果从FileType的XlFileFormat枚举中提供正确的值, Workbook.SaveAs方法将提供正确的文件扩展名。 没有必要保存原稿,因为他们没有收到任何更改。