Question

我正在使用VBScript将多个excel文件中的所有信息移动到主excel文件上的一个工作表中。

它基本上是1000-2000行信息和大约20列。目录中将有大约5-6个excel文件。所有信息都在第一个标签上，我基本上只需要复制并粘贴它，而不会覆盖以前的复制和粘贴数据。

这是我到目前为止所遇到的问题，我遇到的问题是它使用最新的Excel工作表数据复制主文件中以前的Excel工作表数据。我需要它去下一个开放的单元格。

Const xlFilterCopy = 2
Const xlUp = -4162
Const xlDown = -4121
strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
'iColSrc = 1 ' Source column index, e. g. 7 for "G"
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
'iColDst = 1 ' Destination column index

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetTmp = objWorkBookDst.Worksheets.Add
'objSheetTmp.Cells(1, iColDst).Value = "TempHeader"
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    Set objRangeSrc = objSheetSrc.UsedRange
    Set ObjSheetDst = objWorkBookDst.Worksheets.Add
    objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(1, 1), False
    objSheetSrc.Delete
    objWorkBookSrc.Close
Next

Answer 1

你在这里！

strPathSrc = "C:\test" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
strPathDst = "C:\test\Results\Results.xlsx" ' Destination file
iSheetDst = 1 ' Destination sheet index or name

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    GetUsedRange(objSheetSrc).Copy
    Set objUsedRangeDst = GetUsedRange(objSheetDst)
    iRowsCount = objUsedRangeDst.Rows.Count
    objWorkBookDst.Activate
    objSheetDst.Cells(iRowsCount + 1, 1).Select
    objSheetDst.Paste
    objWorkBookDst.Application.CutCopyMode = False
    objWorkBookSrc.Close
Next

Function GetUsedRange(objSheet)
    With objSheet
        Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
    End With
End Function

Answer 2

您可以使用宏录制器录制您想要的内容。

开启录音。按结束键，然后按向下箭头（或您想要的任何方向）。然后再向下箭头到空白单元格。

查看你的vba代码并转换为vbs（宏编码器使用的实验基本语法并没有起飞，因此vbscript并不支持它。）

记录excel宏录制器中的步骤。你必须重写一下，因为它使用了一种vbs不会的语法。

这是一个例子

这适用于（我没有介质9）xlRangeAutoFormatAccounting4在vba中。

Selection.AutoFormat Format:=xlRangeAutoFormatAccounting4, Number:=True, _
    Font:=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True

首先在vba的对象浏览器中查找常量。例如; xlRangeAutoFormatAccounting4 = 17

然后在对象浏览器中查看该函数，并查看函数定义的底部。

EG; Function AutoFormat([Format As XlRangeAutoFormat = xlRangeAutoFormatClassic1], [Number], [Font], [Alignment], [Border], [Pattern], [Width])

所以vba变成vbs（和vbs在vba中工作）（正如你所看到的，你可以通过正确的方式计算出来，而不需要通常查看函数）

Selection.AutoFormat 17, True, True, True,True, True, True

所以你的代码变成了

objXLWs.Range("A3").CurrentRegion.Select.AutoFormat 17, True, True, True,True, True, True

为什么要在vbscript而不是vba中执行此操作。使用vba可以记录代码的大部分内容，vbscript是合法的vba语法，因此您可以继续编写与vbscript完全相同的代码。 VBA在进程中运行而vbs不在进程中（缓慢 - 假装使用网络进行通信）。在VBA中，您可以提前绑定（设置xlApp = excel.application）而不是后期绑定（设置xlapp = CreateObject（＆＃34; Excel.Application＆＃34;），因为后期绑定需要在每次函数调用之前进行对话。

VBS将多个excel文件中的信息编译成一个

2 个答案: