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

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:testResultsResults.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:testResultsResults.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没有的语法类型。

这里有一个例子

这适用于(我没有介质)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(" excel.application "))，因为延迟绑定需要在每个函数调用之前进行对话。