0

我需要用 vbscript(不是 vba)来完成这个。我找不到任何如何做到这一点的例子。我有 vbs 可以对我需要的 Excel 文件进行所有主要处理,但我需要的最后一块是将驻留在 2 个单独的 .xlsx 文件中的两个工作表合并到一个工作表中到一个新工作簿中。

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

我对此很接近,这会将两个数据表带到同一个名为“合并”的新工作簿中,但需要它将工作表合并为一个。

    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
4

1 回答 1

1

如果您执行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

如果您从XlFileFormat 枚举中为FileType提供正确的值,Workbook.SaveAs 方法将提供正确的文件扩展名。没有必要保存原件,因为它们没有收到任何更改。

于 2016-01-16T20:11:37.727 回答