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

VBS to compile information from multiple excel files into one

提问by user3216733

I'm working on VBScript to move all the information from multiple excel files into one sheet on a master excel file.

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

It would basically be 1000-2000 rows of information and about 20 columns. There would be about 5-6 total excel files in the directory. All of the information is on the first tab, I essentially just need to copy and paste it over without overwriting the previously copy and pasted data.

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

This is what I have so far, the issue I'm running into is that it copies over the previous excel sheets data in the master file with the most recent excel sheet's data. I need it to go to the next open cell.

这就是我到目前为止所遇到的问题，我遇到的问题是它使用最新的 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

回答by omegastripes

Here you are!

这个给你！

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

回答by tony b

You can use the macro recorder to record what you want.

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

Turn recording on. Press End key then Down Arrow (or whatever direction you want to go). Then down arrow again to the blank cell.

打开录音。按 End 键，然后按向下箭头（或您想去的任何方向）。然后再次向下箭头指向空白单元格。

Look at your vba code and convert to vbs (macro recoder uses a experimental basic syntax that didn't take off so vbscript didn't support it).

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

Record the steps in excel macro recorder. You have to rewrite it a bit because it uses a type of syntax that vbs doesn't.

在excel宏记录器中记录步骤。您必须稍微重写一下，因为它使用了一种 vbs 没有的语法。

Here's an example

这是一个例子

This applies (I don't have a medium9) xlRangeAutoFormatAccounting4 in vba.

这在 vba 中适用（我没有 medium9）xlRangeAutoFormatAccounting4。

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

So first look up constants in vba's object browser. eg; xlRangeAutoFormatAccounting4 = 17

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

Then look the function up in object browser and look at the bottom for the function definition,.

然后在对象浏览器中向上查找函数，并在底部查找函数定义。

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

So the vba becomes in vbs (and vbs works in vba) (and as you can see you can work out the correct way without needing to look the function up usually)

所以vba变成了vbs（而vbs在vba中工作）（正如你所见，你可以找出正确的方法，而无需通常查找函数）

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

So your code becomes

所以你的代码变成

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

Why would you do it in vbscript rather than vba. Using vba you can record large parts of your code and vbscript is legal vba syntax, so you can continue to write exactly the same code as in vbscript. VBA runs inprocess while vbs is out of proocess (slow - pretends to use a network to communicate). In VBA you can early bind (set xlApp = excel.application) rather than late bind (set xlapp = CreateObject("Excel.Application") as late binding requires a conversation before EVERY function call.

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