将两个.xlsx工作表组合在单独的xlsx文件中,并将其合并到新工作簿中的单个工作表中

时间:2016-01-14 18:37:22

标签: excel vbscript merge excel.application

我需要用vbscript(而不是vba)来完成这个任务。我找不到任何如何做到这一点的例子。我有vbs对我需要的Excel文件进​​行所有主要处理,但我需要的最后一个部分就是将两个独立的.xlsx文件中的两个工作表合并为一个工作表到一个新工作簿中。

我已经找到了使用vba将2个文件合并为单个wb并使用单独的工作表的示例,但我需要在同一个工作表和vbscript上使用它们。它基本上就像是两张纸的结合。它们都包含相同数量的列(6列)和相同类型的数据。基本上需要从任一电子表格中复制标题并粘贴到新的工作簿/工作表中,然后将每个数据中的所有数据复制到标题下方的新工作簿/工作表中。希望这是有道理的。任何帮助表示赞赏。

我对此已经半熟,这将两个数据表放入名为“merged”的同一个新工作簿中,但需要将它们合并为一个。

    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

==========================

这是我提出的解决方案(使用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

1 个答案:

答案 0 :(得分:1)

如果您执行Worksheet.Copy method并忽略提供目的地,则工作表将被复制到包含ActiveWorkbook property的新工作簿。这可能是开始新工作簿的最佳方式。

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 Workbook.SaveAs method提供了正确的值,XlFileFormat Enumeration将提供正确的文件扩展名。没有必要保存原件,因为它们没有收到任何更改。